[project @ 2000-10-24 08:40:09 by simonpj]

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

diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs
index fc0a8d5..bcb1d9d 100644 (file)
--- a/ghc/compiler/stgSyn/CoreToStg.lhs
+++ b/ghc/compiler/stgSyn/CoreToStg.lhs
@@ -17,32 +17,25 @@ module CoreToStg ( topCoreBindsToStg ) where
 import CoreSyn         -- input
 import StgSyn          -- output
 
-import PprCore         ( {- instance Outputable Bind/Expr -} )
 import CoreUtils       ( exprType )
 import SimplUtils      ( findDefault )
 import CostCentre      ( noCCS )
-import Id              ( Id, mkSysLocal, idType, idStrictness, idUnique, isExportedId, mkVanillaId,
-                         externallyVisibleId, setIdUnique, idName, 
-                         idDemandInfo, idArity, setIdType, idFlavour
+import Id              ( Id, mkSysLocal, idType, idStrictness, isExportedId, 
+                         mkVanillaId, idName, idDemandInfo, idArity, setIdType,
+                         idFlavour
                        )
-import Var             ( Var, varType, modifyIdInfo )
-import IdInfo          ( setDemandInfo, StrictnessInfo(..), IdFlavour(..) )
-import UsageSPUtils     ( primOpUsgTys )
-import DataCon         ( DataCon, dataConName, dataConWrapId )
-import Demand          ( Demand, isStrict, wwStrict, wwLazy )
-import Name            ( Name, nameModule, isLocallyDefinedName, setNameUnique )
-import Literal         ( Literal(..) )
+import IdInfo          ( StrictnessInfo(..), IdFlavour(..) )
+import DataCon         ( dataConWrapId )
+import Demand          ( Demand, isStrict, wwLazy )
+import Name            ( setNameUnique )
 import VarEnv
-import PrimOp          ( PrimOp(..), CCall(..), CCallTarget(..), primOpUsg )
+import PrimOp          ( PrimOp(..), setCCallUnique )
 import Type            ( isUnLiftedType, isUnboxedTupleType, Type, splitFunTy_maybe,
-                          UsageAnn(..), tyUsg, applyTy, mkUsgTy, repType, seqType,
+                          UsageAnn(..), tyUsg, applyTy, repType, seqType,
                          splitRepFunTys, mkFunTys
                        )
-import TysPrim         ( intPrimTy )
 import UniqSupply      -- all of it, really
-import Util            ( lengthExceeds )
-import BasicTypes      ( TopLevelFlag(..), isNotTopLevel, Arity )
-import CmdLineOpts     ( opt_D_verbose_stg2stg, opt_UsageSPOn )
+import BasicTypes      ( TopLevelFlag(..), isNotTopLevel )
 import UniqSet         ( emptyUniqSet )
 import Maybes
 import Outputable
@@ -173,12 +166,10 @@ locations.
 
 \begin{code}
 bOGUS_LVs :: StgLiveVars
-bOGUS_LVs | opt_D_verbose_stg2stg = emptyUniqSet
-         | otherwise =panic "bOGUS_LVs"
+bOGUS_LVs = emptyUniqSet
 
 bOGUS_FVs :: [Id]
-bOGUS_FVs | opt_D_verbose_stg2stg = [] 
-         | otherwise = panic "bOGUS_FVs"
+bOGUS_FVs = [] 
 \end{code}
 
 \begin{code}
@@ -657,11 +648,14 @@ mkStgApp env fn args ty
        -> saturate fn_alias args ty    $ \ args' ty' ->
           returnUs (StgConApp dc args')
 
-      PrimOpId (CCallOp (CCall (DynamicTarget _) a b c))
+      PrimOpId (CCallOp ccall)
                -- Sigh...make a guaranteed unique name for a dynamic ccall
+               -- Done here, not earlier, because it's a code-gen thing
        -> saturate fn_alias args ty    $ \ args' ty' ->
-          getUniqueUs                  `thenUs` \ u ->
-           returnUs (StgPrimApp (CCallOp (CCall (DynamicTarget u) a b c)) args' ty')
+          getUniqueUs                  `thenUs` \ uniq ->
+           let ccall' = setCCallUnique ccall uniq in
+          returnUs (StgPrimApp (CCallOp ccall') args' ty')
+          
 
       PrimOpId op 
        -> saturate fn_alias args ty    $ \ args' ty' ->