diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-05-12 11:40:03 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-06-13 02:13:02 -0400 |
commit | e7272d53e67e72580caceae40e766c4bfeb1c398 (patch) | |
tree | 5e0d06cf3fc31e737ea385b53efe22e5916e847a /compiler/GHC/StgToCmm | |
parent | f6be6e432e53108075905c1fc7785d8b1f18a33f (diff) | |
download | haskell-e7272d53e67e72580caceae40e766c4bfeb1c398.tar.gz |
Enhance UnitId use
* use UnitId instead of String to identify wired-in units
* use UnitId instead of Unit in the backend (Unit are only use by
Backpack to produce type-checked interfaces, not real code)
* rename lookup functions for consistency
* documentation
Diffstat (limited to 'compiler/GHC/StgToCmm')
-rw-r--r-- | compiler/GHC/StgToCmm/ExtCode.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/StgToCmm/Prim.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/StgToCmm/Utils.hs | 4 |
3 files changed, 7 insertions, 7 deletions
diff --git a/compiler/GHC/StgToCmm/ExtCode.hs b/compiler/GHC/StgToCmm/ExtCode.hs index 49f6a21b9c..e0b20021b3 100644 --- a/compiler/GHC/StgToCmm/ExtCode.hs +++ b/compiler/GHC/StgToCmm/ExtCode.hs @@ -61,7 +61,7 @@ data Named = VarN CmmExpr -- ^ Holds CmmLit(CmmLabel ..) which gives the label type, -- eg, RtsLabel, ForeignLabel, CmmLabel etc. - | FunN Unit -- ^ A function name from this package + | FunN UnitId -- ^ A function name from this unit | LabelN BlockId -- ^ A blockid of some code or data. -- | An environment of named things. @@ -165,7 +165,7 @@ newLabel name = do -- | Add add a local function to the environment. newFunctionName :: FastString -- ^ name of the function - -> Unit -- ^ package of the current module + -> UnitId -- ^ package of the current module -> ExtCode newFunctionName name pkg = addDecl name (FunN pkg) @@ -204,7 +204,7 @@ lookupName name = do return $ case lookupUFM env name of Just (VarN e) -> e - Just (FunN pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg name)) + Just (FunN uid) -> CmmLit (CmmLabel (mkCmmCodeLabel uid name)) _other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId name)) diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs index b0f9fddad6..e70f50ee84 100644 --- a/compiler/GHC/StgToCmm/Prim.hs +++ b/compiler/GHC/StgToCmm/Prim.hs @@ -42,7 +42,7 @@ import GHC.Cmm.BlockId import GHC.Cmm.Graph import GHC.Stg.Syntax import GHC.Cmm -import GHC.Unit ( rtsUnitId ) +import GHC.Unit ( rtsUnit ) import GHC.Core.Type ( Type, tyConAppTyCon ) import GHC.Core.TyCon import GHC.Cmm.CLabel @@ -3043,7 +3043,7 @@ emitCopyUpdRemSetPush platform hdr_size dst dst_off n = emit graph where lbl = mkLblExpr $ mkPrimCallLabel - $ PrimCall (fsLit "stg_copyArray_barrier") rtsUnitId + $ PrimCall (fsLit "stg_copyArray_barrier") rtsUnit args = [ mkIntExpr platform hdr_size , dst diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs index 3815c2b698..6367f5e839 100644 --- a/compiler/GHC/StgToCmm/Utils.hs +++ b/compiler/GHC/StgToCmm/Utils.hs @@ -180,10 +180,10 @@ tagToClosure platform tycon tag -- ------------------------------------------------------------------------- -emitRtsCall :: Unit -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () +emitRtsCall :: UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () emitRtsCall pkg fun args safe = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) args safe -emitRtsCallWithResult :: LocalReg -> ForeignHint -> Unit -> FastString +emitRtsCallWithResult :: LocalReg -> ForeignHint -> UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () emitRtsCallWithResult res hint pkg fun args safe = emitRtsCallGen [(res,hint)] (mkCmmCodeLabel pkg fun) args safe |