[project @ 1996-06-26 10:26:00 by partain]

[ghc-hetmet.git] / ghc / compiler / stgSyn / StgSyn.lhs

diff --git a/ghc/compiler/stgSyn/StgSyn.lhs b/ghc/compiler/stgSyn/StgSyn.lhs
index 456a7f8..bac7e8a 100644 (file)
--- a/ghc/compiler/stgSyn/StgSyn.lhs
+++ b/ghc/compiler/stgSyn/StgSyn.lhs
@@ -13,7 +13,7 @@ suited to spineless tagless code generation.
 
 module StgSyn (
        GenStgArg(..),
-       GenStgLiveVars(..),
+       SYN_IE(GenStgLiveVars),
 
        GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),
        GenStgCaseAlts(..), GenStgCaseDefault(..),
@@ -26,42 +26,33 @@ module StgSyn (
        combineStgBinderInfo,
 
        -- a set of synonyms for the most common (only :-) parameterisation
-       StgArg(..), StgLiveVars(..),
-       StgBinding(..), StgExpr(..), StgRhs(..),
-       StgCaseAlts(..), StgCaseDefault(..),
+       SYN_IE(StgArg), SYN_IE(StgLiveVars),
+       SYN_IE(StgBinding), SYN_IE(StgExpr), SYN_IE(StgRhs),
+       SYN_IE(StgCaseAlts), SYN_IE(StgCaseDefault),
 
        pprPlainStgBinding,
        getArgPrimRep,
        isLitLitArg,
        stgArity,
-       collectExportedStgBinders
-
-       -- and to make the interface self-sufficient...
+       collectFinalStgBinders
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
-{-
-import PrelInfo                ( getPrimOpResultInfo, PrimOpResultInfo(..),
-                         PrimOp, PrimRep
-                         IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
-                         IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
-                       )
-import HsSyn           ( HsBinds, HsExpr, GRHS, GRHSsAndBinds, InPat )
-import Type
-import Literal         ( literalPrimRep, isLitLitLit,
-                         Literal(..) -- (..) for pragmas
+import CostCentre      ( showCostCentre )
+import Id              ( externallyVisibleId, idPrimRep, GenId{-instance NamedThing-} )
+import Literal         ( literalPrimRep, isLitLitLit, Literal{-instance Outputable-} )
+import Name            ( isSymLexeme )
+import Outputable      ( ifPprDebug, interppSP, interpp'SP,
+                         Outputable(..){-instance * Bool-}
                        )
-import Id              ( idType, getIdPrimRep, toplevelishId,
-                         isTopLevId, Id, IdInfo
-                       )
-import Maybes          ( Maybe(..), catMaybes )
-import Outputable
-import Pretty
-import CostCentre      ( showCostCentre, CostCentre )
-import UniqSet
-import Util
--}
+import PprStyle                ( PprStyle(..) )
+import PprType         ( GenType{-instance Outputable-} )
+import Pretty          -- all of it
+import PrimOp          ( PrimOp{-instance Outputable-} )
+import Unique          ( pprUnique )
+import UniqSet         ( isEmptyUniqSet, uniqSetToList, SYN_IE(UniqSet) )
+import Util            ( panic )
 \end{code}
 
 %************************************************************************
@@ -79,6 +70,7 @@ with respect to binder and occurrence information (just as in
 data GenStgBinding bndr occ
   = StgNonRec  bndr (GenStgRhs bndr occ)
   | StgRec     [(bndr, GenStgRhs bndr occ)]
+  | StgCoerceBinding bndr occ
 \end{code}
 
 %************************************************************************
@@ -94,8 +86,8 @@ data GenStgArg occ
 \end{code}
 
 \begin{code}
-getArgPrimRep (StgVarArg  local) = getIdPrimRep local
-getArgPrimRep (StgLitArg  lit) = literalPrimRep lit
+getArgPrimRep (StgVarArg  local) = idPrimRep local
+getArgPrimRep (StgLitArg  lit)  = literalPrimRep lit
 
 isLitLitArg (StgLitArg x) = isLitLitLit x
 isLitLitArg _            = False
@@ -484,17 +476,17 @@ final pre-codegen STG code, so as to be sure we have the
 latest/greatest pragma info.
 
 \begin{code}
-collectExportedStgBinders
+collectFinalStgBinders
        :: [StgBinding] -- input program
-       -> [Id]                 -- exported top-level Ids
+       -> [Id]         -- final externally-visible top-level Ids
 
-collectExportedStgBinders binds
+collectFinalStgBinders binds
   = ex [] binds
   where
     ex es [] = es
 
     ex es ((StgNonRec b _) : binds)
-      = if not (isExported b) then
+      = if not (externallyVisibleId b) then
            ex es binds
        else
            ex (b:es) binds
@@ -523,6 +515,10 @@ pprStgBinding sty (StgNonRec bndr rhs)
   = ppHang (ppCat [ppr sty bndr, ppEquals])
         4 (ppBeside (ppr sty rhs) ppSemi)
 
+pprStgBinding sty (StgCoerceBinding bndr occ)
+  = ppHang (ppCat [ppr sty bndr, ppEquals, ppStr "{-Coerce-}"])
+        4 (ppBeside (ppr sty occ) ppSemi)
+
 pprStgBinding sty (StgRec pairs)
   = ppAboves ((ifPprDebug sty (ppStr "{- StgRec -}")) :
              (map (ppr_bind sty) pairs))
@@ -659,7 +655,7 @@ pprStgExpr sty (StgCase expr lvs_whole lvs_rhss uniq alts)
                   4 (ppBeside (ppr sty expr) ppSemi)
          where
            ppr_con sty con
-             = if isOpLexeme con
+             = if isSymLexeme con
                then ppBesides [ppLparen, ppr sty con, ppRparen]
                else ppr sty con
 
@@ -710,7 +706,7 @@ pprStgRhs sty (StgRhsClosure cc bi free_vars upd_flag args body)
 
 pprStgRhs sty (StgRhsCon cc con args)
   = ppBesides [ ppStr (showCostCentre sty True{-as String-} cc),
-               ppSP, ppr sty con, ppStr " [", interppSP sty args, ppStr "]" ]
+               ppSP, ppr sty con, ppStr "! [", interppSP sty args, ppStr "]" ]
 
 --------------
 pp_binder_info PprForUser _ = ppNil