diff --git a/compiler/GHC/StgToJS/Apply.hs b/compiler/GHC/StgToJS/Apply.hs
index 60817a67b26cfaa312b79cdc08c255751fa34607..4cc52096163d20c3cb471294db61fbd140acba5a 100644
--- a/compiler/GHC/StgToJS/Apply.hs
+++ b/compiler/GHC/StgToJS/Apply.hs
@@ -153,7 +153,7 @@ genApp ctx i args
-- object representation
-- - returns the object directly, otherwise
| [] <- args
- , [vt] <- idVt i
+ , [vt] <- idJSRep i
, isUnboxable vt
, ctxIsEvaluated ctx i
= do
diff --git a/compiler/GHC/StgToJS/Arg.hs b/compiler/GHC/StgToJS/Arg.hs
index 78cb72b50f2150f301e84f268cfcbea4bb3ffe3c..56841d2080c565df83ade098cd97d74a8116cd52 100644
--- a/compiler/GHC/StgToJS/Arg.hs
+++ b/compiler/GHC/StgToJS/Arg.hs
@@ -118,7 +118,7 @@ genStaticArg a = case a of
Nothing -> reg
Just expr -> unfloated expr
where
- r = uTypeVt . stgArgType $ a
+ r = unaryTypeJSRep . stgArgType $ a
reg
| isVoid r =
return []
@@ -159,8 +159,8 @@ genArg a = case a of
where
-- if our argument is a joinid, it can be an unboxed tuple
- r :: HasDebugCallStack => VarType
- r = uTypeVt . stgArgType $ a
+ r :: HasDebugCallStack => JSRep
+ r = unaryTypeJSRep . stgArgType $ a
unfloated :: HasDebugCallStack => CgStgExpr -> G [JExpr]
unfloated = \case
@@ -187,7 +187,7 @@ genIdArgI i
| isMultiVar r = mapM (identForIdN i) [1..varSize r]
| otherwise = (:[]) <$> identForId i
where
- r = uTypeVt . idType $ i
+ r = unaryTypeJSRep . idType $ i
-- | Generate IDs for stack arguments. See 'StgToJS.Expr.loadRetArgs' for use case
genIdStackArgI :: HasDebugCallStack => Id -> G [(Ident,StackSlot)]
diff --git a/compiler/GHC/StgToJS/CodeGen.hs b/compiler/GHC/StgToJS/CodeGen.hs
index 8b04f9bb5f4fb13475382c70d833199d4b77a66b..9632fbbf5088d36fe656669039658a29d373336b 100644
--- a/compiler/GHC/StgToJS/CodeGen.hs
+++ b/compiler/GHC/StgToJS/CodeGen.hs
@@ -304,7 +304,7 @@ genSetConInfo i d l {- srt -} = do
emitClosureInfo $ ClosureInfo ei
(CIRegs 0 [PtrV])
(mkFastString $ renderWithContext defaultSDocContext (ppr d))
- (fixedLayout $ map uTypeVt fields)
+ (fixedLayout $ map unaryTypeJSRep fields)
(CICon $ dataConTag d)
sr
return (mkDataEntry ei)
@@ -350,8 +350,8 @@ genToplevelRhs i rhs = case rhs of
r <- updateThunk
pure (StaticThunk (Just (eidt, map StaticObjArg lidents')), CIRegs 0 [PtrV],r)
else return (StaticFun eidt (map StaticObjArg lidents'),
- (if null lidents then CIRegs 1 (concatMap idVt args)
- else CIRegs 0 (PtrV : concatMap idVt args))
+ (if null lidents then CIRegs 1 (concatMap idJSRep args)
+ else CIRegs 0 (PtrV : concatMap idJSRep args))
, mempty)
setcc <- ifProfiling $
if et == CIThunk
@@ -360,7 +360,7 @@ genToplevelRhs i rhs = case rhs of
emitClosureInfo (ClosureInfo eid
regs
idt
- (fixedLayout $ map (uTypeVt . idType) lids)
+ (fixedLayout $ map (unaryTypeJSRep . idType) lids)
et
sr)
ccId <- costCentreStackLbl cc
diff --git a/compiler/GHC/StgToJS/Expr.hs b/compiler/GHC/StgToJS/Expr.hs
index f058e4581991ba9ab6b9ccca36388cfcd29e3b41..6bcf5803a44e53257888f7ec4d770d79474bfb27 100644
--- a/compiler/GHC/StgToJS/Expr.hs
+++ b/compiler/GHC/StgToJS/Expr.hs
@@ -241,7 +241,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body typ) =
let f = (bh <> lvs <> body)
emitClosureInfo $
ClosureInfo ei
- (CIRegs 0 $ concatMap idVt args)
+ (CIRegs 0 $ concatMap idJSRep args)
(eii <> ", " <> mkFastString (renderWithContext defaultSDocContext (ppr i)))
(fixedLayout . reverse $
map (stackSlotType . fst) (ctxLneFrameVars ctx))
@@ -275,9 +275,9 @@ genEntry ctx i rhs@(StgRhsClosure _ext cc {-_bi live-} upd_flag args body typ) =
else enterCostCentreFun cc
sr <- genStaticRefsRhs rhs
emitClosureInfo $ ClosureInfo ei
- (CIRegs 0 $ PtrV : concatMap idVt args)
+ (CIRegs 0 $ PtrV : concatMap idJSRep args)
(eii <> ", " <> mkFastString (renderWithContext defaultSDocContext (ppr i)))
- (fixedLayout $ map (uTypeVt . idType) live)
+ (fixedLayout $ map (unaryTypeJSRep . idType) live)
et
sr
emitToplevel (jFunction ei [] (mconcat [ll, llv, upd, setcc, body]))
@@ -373,7 +373,7 @@ verifyRuntimeReps xs = do
where
verifyRuntimeRep i = do
i' <- varsForId i
- pure $ go i' (idVt i)
+ pure $ go i' (idJSRep i)
go js (VoidV:vs) = go js vs
go (j1:j2:js) (LongV:vs) = v "h$verify_rep_long" [j1,j2] <> go js vs
go (j1:j2:js) (AddrV:vs) = v "h$verify_rep_addr" [j1,j2] <> go js vs
@@ -491,11 +491,11 @@ optimizeFree
-- -- Bool: True when the slot already contains a value
optimizeFree offset ids = do
-- this line goes wrong vvvvvvv
- let -- ids' = concat $ map (\i -> map (i,) [1..varSize . uTypeVt . idType $ i]) ids
+ let -- ids' = concat $ map (\i -> map (i,) [1..varSize . unaryTypeJSRep . idType $ i]) ids
idSize :: Id -> Int
- idSize i = sum $ map varSize (typeVt . idType $ i)
+ idSize i = sum $ map varSize (typeJSRep . idType $ i)
ids' = concatMap (\i -> map (i,) [1..idSize i]) ids
- -- 1..varSize] . uTypeVt . idType $ i]) (typeVt ids)
+ -- 1..varSize] . unaryTypeJSRep . idType $ i]) (typeJSRep ids)
l = length ids'
slots <- drop offset . take l . (++repeat SlotUnknown) <$> getSlots
let slm = M.fromList (zip slots [0..])
@@ -630,10 +630,10 @@ genRet ctx e at as l = freshIdent >>= f
return (pushLne <> saveCCS <> pushRet)
fst3 ~(x,_,_) = x
- altRegs :: HasDebugCallStack => [VarType]
+ altRegs :: HasDebugCallStack => [JSRep]
altRegs = case at of
- PrimAlt ptc -> [primRepVt ptc]
- MultiValAlt _n -> idVt e
+ PrimAlt ptc -> [primRepToJSRep ptc]
+ MultiValAlt _n -> idJSRep e
_ -> [PtrV]
-- special case for popping CCS but preserving stack size
@@ -690,7 +690,7 @@ genAlts ctx e at me alts = do
-> do
ie <- varsForId e
(r, bss) <- normalizeBranches ctx <$>
- mapM (isolateSlots . mkPrimIfBranch ctx [primRepVt tc]) alts
+ mapM (isolateSlots . mkPrimIfBranch ctx [primRepToJSRep tc]) alts
setSlots []
return (mkSw ie bss, r)
@@ -877,7 +877,7 @@ mkAlgBranch top d alt
-- | Generate a primitive If-expression
mkPrimIfBranch :: ExprCtx
- -> [VarType]
+ -> [JSRep]
-> CgStgAlt
-> G (Branch (Maybe [JExpr]))
mkPrimIfBranch top _vt alt =
diff --git a/compiler/GHC/StgToJS/FFI.hs b/compiler/GHC/StgToJS/FFI.hs
index 751334587bff2bf6e03a2bc66b0f4fbe4774e7c0..90204f700abf0912a07d60c76e980d39fe8a3f69 100644
--- a/compiler/GHC/StgToJS/FFI.hs
+++ b/compiler/GHC/StgToJS/FFI.hs
@@ -175,7 +175,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i)
where
tycon = tyConAppTyCon (unwrapType arg_ty)
arg_ty = stgArgType a
- r = uTypeVt arg_ty
+ r = unaryTypeJSRep arg_ty
saturateFFI :: Int -> JStat -> Sat.JStat
saturateFFI u = satJStat (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u)
diff --git a/compiler/GHC/StgToJS/Object.hs b/compiler/GHC/StgToJS/Object.hs
index f986859ea0cd5ac9f39de1b2d55248ac104aa6c3..e56cb82d2aca329daa67e9c34e1ad508ac1b7ee0 100644
--- a/compiler/GHC/StgToJS/Object.hs
+++ b/compiler/GHC/StgToJS/Object.hs
@@ -509,7 +509,7 @@ instance Binary JSFFIType where
put_ bh = putEnum bh
get bh = getEnum bh
-instance Binary VarType where
+instance Binary JSRep where
put_ bh = putEnum bh
get bh = getEnum bh
diff --git a/compiler/GHC/StgToJS/Types.hs b/compiler/GHC/StgToJS/Types.hs
index 415d1b159fe0d9c3d1859f3fdbcab42b74debbc4..84b7c27c5318fd0390f2e7bf5c9d6e3a2f251f0c 100644
--- a/compiler/GHC/StgToJS/Types.hs
+++ b/compiler/GHC/StgToJS/Types.hs
@@ -110,7 +110,7 @@ data ClosureInfo = ClosureInfo
data CIRegs
= CIRegsUnknown -- ^ A value witnessing a state of unknown registers
| CIRegs { ciRegsSkip :: Int -- ^ unused registers before actual args start
- , ciRegsTypes :: [VarType] -- ^ args
+ , ciRegsTypes :: [JSRep] -- ^ args
}
deriving stock (Eq, Ord, Show)
@@ -122,7 +122,7 @@ data CILayout
}
| CILayoutFixed -- ^ whole layout known
{ layoutSize :: !Int -- ^ closure size in array positions, including entry
- , layout :: [VarType] -- ^ The set of sized Types to layout
+ , layout :: [JSRep] -- ^ The list of JSReps to layout
}
deriving stock (Eq, Ord, Show)
@@ -149,8 +149,8 @@ instance ToJExpr CIStatic where
toJExpr (CIStaticRefs []) = null_ -- [je| null |]
toJExpr (CIStaticRefs rs) = toJExpr (map TxtI rs)
--- | Free variable types
-data VarType
+-- | JS primitive representations
+data JSRep
= PtrV -- ^ pointer = reference to heap object (closure object), lifted or not.
-- Can also be some RTS object (e.g. TVar#, MVar#, MutVar#, Weak#)
| VoidV -- ^ no fields
@@ -162,7 +162,7 @@ data VarType
| ArrV -- ^ boxed array
deriving stock (Eq, Ord, Enum, Bounded, Show)
-instance ToJExpr VarType where
+instance ToJExpr JSRep where
toJExpr = toJExpr . fromEnum
-- | The type of identifiers. These determine the suffix of generated functions
diff --git a/compiler/GHC/StgToJS/Utils.hs b/compiler/GHC/StgToJS/Utils.hs
index 7fc60e5db345ca57fa1df3fe7e8ee88b19b8dcec..bf885e7ddf937367a55174e0d77db2e06d48a0e6 100644
--- a/compiler/GHC/StgToJS/Utils.hs
+++ b/compiler/GHC/StgToJS/Utils.hs
@@ -10,16 +10,16 @@ module GHC.StgToJS.Utils
, isUnboxableCon
, isUnboxable
, isBoolDataCon
- -- * JsRep
+ -- * JSRep
, slotCount
, varSize
, typeSize
, isVoid
, isMultiVar
- , idVt
- , typeVt
- , uTypeVt
- , primRepVt
+ , idJSRep
+ , typeJSRep
+ , unaryTypeJSRep
+ , primRepToJSRep
, stackSlotType
, primRepSize
, mkArityTag
@@ -131,7 +131,7 @@ assignCoerce p1 p2 = assignTypedExprs [p1] [p2]
isUnboxableCon :: DataCon -> Bool
isUnboxableCon dc
| [t] <- dataConRepArgTys dc
- , [t1] <- typeVt (scaledThing t)
+ , [t1] <- typeJSRep (scaledThing t)
= isUnboxable t1 &&
dataConTag dc == 1 &&
length (tyConDataCons $ dataConTyCon dc) == 1
@@ -139,7 +139,7 @@ isUnboxableCon dc
-- | one-constructor types with one primitive field represented as a JS Number
-- can be unboxed
-isUnboxable :: VarType -> Bool
+isUnboxable :: JSRep -> Bool
isUnboxable DoubleV = True
isUnboxable IntV = True -- includes Char#
isUnboxable _ = False
@@ -162,68 +162,68 @@ slotCount = \case
TwoSlots -> 2
--- | Number of slots occupied by a value with the given VarType
-varSize :: VarType -> Int
-varSize = slotCount . varSlotCount
+-- | Number of slots occupied by a value with the given JSRep
+varSize :: JSRep -> Int
+varSize = slotCount . jsRepSlots
-varSlotCount :: VarType -> SlotCount
-varSlotCount VoidV = NoSlot
-varSlotCount LongV = TwoSlots -- hi, low
-varSlotCount AddrV = TwoSlots -- obj/array, offset
-varSlotCount _ = OneSlot
+jsRepSlots :: JSRep -> SlotCount
+jsRepSlots VoidV = NoSlot
+jsRepSlots LongV = TwoSlots -- hi, low
+jsRepSlots AddrV = TwoSlots -- obj/array, offset
+jsRepSlots _ = OneSlot
typeSize :: Type -> Int
-typeSize t = sum . map varSize . typeVt $ t
+typeSize t = sum . map varSize . typeJSRep $ t
-isVoid :: VarType -> Bool
+isVoid :: JSRep -> Bool
isVoid VoidV = True
isVoid _ = False
-isMultiVar :: VarType -> Bool
-isMultiVar v = case varSlotCount v of
+isMultiVar :: JSRep -> Bool
+isMultiVar v = case jsRepSlots v of
NoSlot -> False
OneSlot -> False
TwoSlots -> True
-idVt :: HasDebugCallStack => Id -> [VarType]
-idVt = typeVt . idType
+idJSRep :: HasDebugCallStack => Id -> [JSRep]
+idJSRep = typeJSRep . idType
-typeVt :: HasDebugCallStack => Type -> [VarType]
-typeVt t | isRuntimeRepKindedTy t = []
-typeVt t = map primRepVt (typePrimRep t)-- map uTypeVt (repTypeArgs t)
+typeJSRep :: HasDebugCallStack => Type -> [JSRep]
+typeJSRep t | isRuntimeRepKindedTy t = []
+typeJSRep t = map primRepToJSRep (typePrimRep t)-- map unaryTypeJSRep (repTypeArgs t)
-- only use if you know it's not an unboxed tuple
-uTypeVt :: HasDebugCallStack => UnaryType -> VarType
-uTypeVt ut
+unaryTypeJSRep :: HasDebugCallStack => UnaryType -> JSRep
+unaryTypeJSRep ut
| isRuntimeRepKindedTy ut = VoidV
-- | isRuntimeRepTy ut = VoidV
-- GHC panics on this otherwise
| Just (tc, ty_args) <- splitTyConApp_maybe ut
, length ty_args /= tyConArity tc = PtrV
- | isPrimitiveType ut = (primTypeVt ut)
+ | isPrimitiveType ut = (primTypeJSRep ut)
| otherwise =
case typePrimRep' ut of
[] -> VoidV
- [pt] -> primRepVt pt
- _ -> pprPanic "uTypeVt: not unary" (ppr ut)
-
-primRepVt :: HasDebugCallStack => PrimRep -> VarType
-primRepVt VoidRep = VoidV
-primRepVt (BoxedRep _) = PtrV -- fixme does ByteArray# ever map to this?
-primRepVt IntRep = IntV
-primRepVt Int8Rep = IntV
-primRepVt Int16Rep = IntV
-primRepVt Int32Rep = IntV
-primRepVt WordRep = IntV
-primRepVt Word8Rep = IntV
-primRepVt Word16Rep = IntV
-primRepVt Word32Rep = IntV
-primRepVt Int64Rep = LongV
-primRepVt Word64Rep = LongV
-primRepVt AddrRep = AddrV
-primRepVt FloatRep = DoubleV
-primRepVt DoubleRep = DoubleV
-primRepVt (VecRep{}) = error "uTypeVt: vector types are unsupported"
+ [pt] -> primRepToJSRep pt
+ _ -> pprPanic "unaryTypeJSRep: not unary" (ppr ut)
+
+primRepToJSRep :: HasDebugCallStack => PrimRep -> JSRep
+primRepToJSRep VoidRep = VoidV
+primRepToJSRep (BoxedRep _) = PtrV
+primRepToJSRep IntRep = IntV
+primRepToJSRep Int8Rep = IntV
+primRepToJSRep Int16Rep = IntV
+primRepToJSRep Int32Rep = IntV
+primRepToJSRep WordRep = IntV
+primRepToJSRep Word8Rep = IntV
+primRepToJSRep Word16Rep = IntV
+primRepToJSRep Word32Rep = IntV
+primRepToJSRep Int64Rep = LongV
+primRepToJSRep Word64Rep = LongV
+primRepToJSRep AddrRep = AddrV
+primRepToJSRep FloatRep = DoubleV
+primRepToJSRep DoubleRep = DoubleV
+primRepToJSRep (VecRep{}) = error "unaryTypeJSRep: vector types are unsupported"
typePrimRep' :: HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep' ty = kindPrimRep' empty (typeKind ty)
@@ -240,9 +240,9 @@ kindPrimRep' doc (TyConApp _typ [runtime_rep])
kindPrimRep' doc ki
= pprPanic "kindPrimRep'" (ppr ki $$ doc)
-primTypeVt :: HasDebugCallStack => Type -> VarType
-primTypeVt t = case tyConAppTyCon_maybe (unwrapType t) of
- Nothing -> error "primTypeVt: not a TyCon"
+primTypeJSRep :: HasDebugCallStack => Type -> JSRep
+primTypeJSRep t = case tyConAppTyCon_maybe (unwrapType t) of
+ Nothing -> error "primTypeJSRep: not a TyCon"
Just tc
| tc == charPrimTyCon -> IntV
| tc == intPrimTyCon -> IntV
@@ -292,16 +292,16 @@ isBoolDataCon dc = isBoolTy (dataConType dc)
-- standard fixed layout: payload types
-- payload starts at .d1 for heap objects, entry closest to Sp for stack frames
-fixedLayout :: [VarType] -> CILayout
+fixedLayout :: [JSRep] -> CILayout
fixedLayout vts = CILayoutFixed (sum (map varSize vts)) vts
-- 2-var values might have been moved around separately, use DoubleV as substitute
-- ObjV is 1 var, so this is no problem for implicit metadata
-stackSlotType :: Id -> VarType
+stackSlotType :: Id -> JSRep
stackSlotType i
- | OneSlot <- varSlotCount otype = otype
- | otherwise = DoubleV
- where otype = uTypeVt (idType i)
+ | OneSlot <- jsRepSlots otype = otype
+ | otherwise = DoubleV
+ where otype = unaryTypeJSRep (idType i)
idPrimReps :: Id -> [PrimRep]
idPrimReps = typePrimReps . idType
@@ -310,7 +310,7 @@ typePrimReps :: Type -> [PrimRep]
typePrimReps = typePrimRep . unwrapType
primRepSize :: PrimRep -> SlotCount
-primRepSize p = varSlotCount (primRepVt p)
+primRepSize p = jsRepSlots (primRepToJSRep p)
-- | Associate the given values to each RrimRep in the given order, taking into
-- account the number of slots per PrimRep