ghc/compiler/coreSyn/PlainCore.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[PlainCore]{``Plain'' core syntax: the usual parameterisation}
   5
   6 This module defines a particular parameterisation of the @CoreSyntax@
   7 data type.  Both binders and bindees are just @Ids@.  This is the
   8 normal thing.
   9
  10 \begin{code}
  11 #include "HsVersions.h"
  12
  13 module PlainCore (
  14         PlainCoreProgram(..), PlainCoreBinding(..), PlainCoreExpr(..),
  15         PlainCoreAtom(..), PlainCoreCaseAlternatives(..),
  16         PlainCoreCaseDefault(..), PlainCoreArg(..),
  17 #ifdef DPH
  18         PlainCoreParQuals(..),
  19         PlainCoreParCommunicate(..),
  20         CoreParCommunicate(..),
  21         CoreParQuals(..),
  22         isParCoreCaseAlternative,
  23         mkNonRecBinds,
  24 #endif
  25         pprPlainCoreBinding,
  26         pprBigCoreBinder, pprTypedCoreBinder, -- not exported: pprBabyCoreBinder,
  27
  28         CoreBinding(..), CoreExpr(..), CoreAtom(..), -- re-exported
  29         CoreCaseAlternatives(..), CoreCaseDefault(..),
  30         pprCoreExpr,
  31
  32         CoreArg(..), applyToArgs, decomposeArgs, collectArgs,
  33
  34         -- and the related utility functions from CoreFuns...
  35
  36         typeOfCoreExpr,  typeOfCoreAlts,
  37         instCoreExpr,   substCoreExpr,   -- UNUSED: cloneCoreExpr,
  38         substCoreExprUS, -- UNUSED: instCoreExprUS, cloneCoreExprUS,
  39         instCoreBindings,
  40         mkCoLam, mkCoreIfThenElse,
  41 --      mkCoApp, mkCoCon, mkCoPrim, -- no need for export
  42         mkCoApps,
  43         mkCoLetAny, mkCoLetNoUnboxed, mkCoLetUnboxedToCase,
  44         mkCoLetsAny, mkCoLetsNoUnboxed, mkCoLetsUnboxedToCase,
  45         mkCoLetrecAny, mkCoLetrecNoUnboxed,
  46         mkCoTyLam, mkCoTyApp, mkCoTyApps,
  47         mkErrorCoApp, escErrorMsg,
  48         pairsFromCoreBinds,
  49         mkFunction, atomToExpr,
  50         digForLambdas,
  51         exprSmallEnoughToDup,
  52         manifestlyWHNF, manifestlyBottom, --UNUSED: manifestWHNFArgs,
  53         coreExprArity,
  54         isWrapperFor,
  55         maybeErrorApp,
  56 --UNUSED: boilsDownToConApp,
  57         nonErrorRHSs, bindersOf,
  58         squashableDictishCcExpr,
  59
  60         calcUnfoldingGuidance,
  61         pprCoreUnfolding,
  62         mentionedInUnfolding,
  63
  64         -- and one variant of free-var-finding stuff:
  65         addTopBindsFVs, FVCoreExpr(..), FVCoreBinding(..),
  66
  67         -- and to make the interface self-sufficient ...
  68         Outputable(..), NamedThing(..),
  69         ExportFlag, SrcLoc, Unique,
  70         Pretty(..), PprStyle, PrettyRep,
  71
  72         BasicLit, BinderInfo, Class, Id, Demand, IdInfo, FullName,
  73         UnfoldingGuidance, UniType, TauType(..), ThetaType(..),
  74         SigmaType(..), TyVar, TyCon, CostCentre, PrimOp, UniqueSupply,
  75         UniqSM(..), IdEnv(..), UniqFM,
  76         TyVarEnv(..), TypeEnv(..), IdSet(..), UniqSet(..),
  77         Maybe, Bag
  78         IF_ATTACK_PRAGMAS(COMMA cmpClass)
  79         IF_ATTACK_PRAGMAS(COMMA cmpUniType)
  80         IF_ATTACK_PRAGMAS(COMMA initUs) -- profiling
  81
  82 -- NOTE(hilly) Added UniqSM for cloneFunctions
  83
  84     ) where
  85
  86 --IMPORT_Trace  -- ToDo: rm (debugging)
  87
  88 import CoreSyn          -- mostly re-exporting this stuff
  89 import CoreFuns
  90 import CoreUnfold
  91
  92 import AbsUniType       ( TauType(..), ThetaType(..), SigmaType(..),
  93                           Class, UniType, FullName
  94                           IF_ATTACK_PRAGMAS(COMMA cmpClass)
  95                           IF_ATTACK_PRAGMAS(COMMA cmpUniType)
  96                         )
  97 import FreeVars
  98 import Id               ( getIdUniType, getIdStrictness, getIdInfo,
  99                           Id, TypeEnv(..)
 100                         )
 101 import IdEnv            -- ( nullIdEnv, IdEnv )
 102 import IdInfo
 103 import Maybes           ( Maybe(..) )
 104 import Outputable
 105 import Pretty
 106 import Unique           ( UniqSM(..), Unique
 107                           IF_ATTACK_PRAGMAS(COMMA initUs)
 108                         )
 109 import Util
 110
 111 infixr 9 `thenUf`, `thenUf_`
 112 \end{code}
 113
 114 The ``Core things'' just described are parameterised with respect to
 115 the information kept about binding occurrences and bound occurrences
 116 of variables.
 117
 118 The ``Plain Core things'' are instances of the ``Core things'' in
 119 which nothing but a name is kept, for both binders and variables.
 120 \begin{code}
 121 type PlainCoreProgram = [CoreBinding Id Id]
 122 type PlainCoreBinding = CoreBinding  Id Id
 123 type PlainCoreExpr    = CoreExpr     Id Id
 124 type PlainCoreAtom    = CoreAtom        Id
 125 #ifdef DPH
 126 type PlainCoreParQuals          = CoreParQuals Id Id
 127 type PlainCoreParCommunicate    = CoreParCommunicate Id Id
 128 #endif {- Data Parallel Haskell -}
 129 type PlainCoreCaseAlternatives  = CoreCaseAlternatives Id Id
 130 type PlainCoreCaseDefault       = CoreCaseDefault Id Id
 131
 132 type PlainCoreArg = CoreArg Id
 133 \end{code}
 134
 135 %************************************************************************
 136 %*                                                                      *
 137 \subsection[printing-PlainCore]{Printing @PlainCore@ things}
 138 %*                                                                      *
 139 %************************************************************************
 140
 141 The most common core-printing interface:
 142 \begin{code}
 143 pprPlainCoreBinding :: PprStyle -> PlainCoreBinding -> Pretty
 144
 145 pprPlainCoreBinding sty (CoNonRec binder expr)
 146   = ppHang (ppCat [pprBigCoreBinder sty binder, ppEquals])
 147          4 (pprCoreExpr sty pprBigCoreBinder pprBabyCoreBinder ppr expr)
 148
 149 pprPlainCoreBinding sty (CoRec binds)
 150   = ppAboves [ifPprDebug sty (ppStr "{- plain CoRec -}"),
 151               ppAboves (map ppr_bind binds),
 152               ifPprDebug sty (ppStr "{- end plain CoRec -}")]
 153   where
 154     ppr_bind (binder, expr)
 155       = ppHang (ppCat [pprBigCoreBinder sty binder, ppEquals])
 156              4 (pprCoreExpr sty pprBigCoreBinder pprBabyCoreBinder ppr expr)
 157 \end{code}
 158
 159 Other printing bits-and-bobs used with the general @pprCoreBinding@
 160 and @pprCoreExpr@ functions.
 161 \begin{code}
 162 pprBigCoreBinder sty binder
 163   = ppAboves [sig, pragmas, ppr sty binder]
 164   where
 165     sig = ifnotPprShowAll sty (
 166             ppHang (ppCat [ppr sty binder, ppStr "::"])
 167                  4 (ppr sty (getIdUniType binder)))
 168
 169     pragmas = ifnotPprForUser sty (
 170             ppIdInfo sty binder True{-specs, please-} id nullIdEnv (getIdInfo binder))
 171
 172 pprBabyCoreBinder sty binder
 173   = ppCat [ppr sty binder, pp_strictness]
 174   where
 175     pp_strictness
 176       = case (getIdStrictness binder) of
 177           NoStrictnessInfo    -> ppNil
 178           BottomGuaranteed    -> ppStr "{- _!_ -}"
 179           StrictnessInfo xx _ -> ppStr ("{- " ++ (showList xx "") ++ " -}")
 180
 181 pprTypedCoreBinder sty binder
 182   = ppBesides [ppLparen, ppCat [ppr sty binder,
 183         ppStr "::", ppr sty (getIdUniType binder)],
 184         ppRparen]
 185 \end{code}