[Git][ghc/ghc][wip/js-staging] change JS.Transform.Idents* to use UniqDSet from Set
Josh Meredith (@JoshMeredith)
gitlab at gitlab.haskell.org
Tue Sep 27 18:07:06 UTC 2022
Josh Meredith pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
b679d796 by Josh Meredith at 2022-09-27T18:06:50+00:00
change JS.Transform.Idents* to use UniqDSet from Set
- - - - -
5 changed files:
- compiler/GHC/JS/Syntax.hs
- compiler/GHC/JS/Transform.hs
- compiler/GHC/StgToJS/Linker/Compactor.hs
- compiler/GHC/StgToJS/Monad.hs
- compiler/GHC/Types/Unique/Map.hs
Changes:
=====================================
compiler/GHC/JS/Syntax.hs
=====================================
@@ -103,6 +103,7 @@ import GHC.Generics
import GHC.Data.FastString
import GHC.Utils.Monad.State.Strict
+import GHC.Types.Unique
import GHC.Types.Unique.Map
-- | A supply of identifiers, possibly empty
@@ -385,7 +386,8 @@ instance Show SaneDouble where
-- | A newtype wrapper around 'FastString' for JS identifiers.
newtype Ident = TxtI { itxt :: FastString }
- deriving stock (Show, Typeable, Eq, Generic)
+ deriving stock (Show, Typeable, Eq, Generic)
+ deriving newtype (Uniquable)
instance Ord Ident where
compare (TxtI fs1) (TxtI fs2) = lexicalCompareFS fs1 fs2
=====================================
compiler/GHC/JS/Transform.hs
=====================================
@@ -39,15 +39,14 @@ import qualified Data.Map as M
import Text.Read (readMaybe)
import Data.Functor.Identity
import Control.Monad
-import Data.Semigroup
import Data.Bifunctor
-import Data.Set (Set)
-import qualified Data.Set as Set
import GHC.Data.FastString
import GHC.Utils.Monad.State.Strict
import GHC.Utils.Panic
+import GHC.Types.Unique.FM
import GHC.Types.Unique.Map
+import GHC.Types.Unique.DSet
mapExprIdent :: (Ident -> JExpr) -> JExpr -> JExpr
mapExprIdent f = fst (mapIdent f)
@@ -98,50 +97,51 @@ mapIdent f = (map_expr, map_stat)
ContinueStat{} -> s
{-# INLINE identsS #-}
-identsS :: JStat -> Set Ident
+identsS :: JStat -> UniqDSet Ident
identsS = \case
- DeclStat i -> Set.singleton i
+ DeclStat i -> unitUniqDSet i
ReturnStat e -> identsE e
- IfStat e s1 s2 -> identsE e <> identsS s1 <> identsS s2
- WhileStat _ e s -> identsE e <> identsS s
- ForInStat _ i e s -> Set.singleton i <> identsE e <> identsS s
- SwitchStat e xs s -> identsE e <> foldl' (<>) Set.empty (map traverseCase xs) <> identsS s
- where traverseCase (e,s) = identsE e <> identsS s
- TryStat s1 i s2 s3 -> identsS s1 <> Set.singleton i <> identsS s2 <> identsS s3
- BlockStat xs -> foldl' (<>) Set.empty (map identsS xs)
- ApplStat e es -> identsE e <> foldl' (<>) Set.empty (map identsE es)
+ IfStat e s1 s2 -> identsE e `unionUniqDSets` identsS s1 `unionUniqDSets` identsS s2
+ WhileStat _ e s -> identsE e `unionUniqDSets` identsS s
+ ForInStat _ i e s -> unitUniqDSet i `unionUniqDSets` identsE e `unionUniqDSets` identsS s
+ SwitchStat e xs s -> identsE e `unionUniqDSets` foldl' unionUniqDSets emptyUniqDSet (map traverseCase xs) `unionUniqDSets` identsS s
+ where traverseCase (e,s) = identsE e `unionUniqDSets` identsS s
+ TryStat s1 i s2 s3 -> identsS s1 `unionUniqDSets` unitUniqDSet i `unionUniqDSets` identsS s2 `unionUniqDSets` identsS s3
+ BlockStat xs -> foldl' unionUniqDSets emptyUniqDSet (map identsS xs)
+ ApplStat e es -> identsE e `unionUniqDSets` foldl' unionUniqDSets emptyUniqDSet (map identsE es)
UOpStat _op e -> identsE e
- AssignStat e1 e2 -> identsE e1 <> identsE e2
+ AssignStat e1 e2 -> identsE e1 `unionUniqDSets` identsE e2
UnsatBlock{} -> error "identsS: UnsatBlock"
LabelStat _l s -> identsS s
- BreakStat{} -> Set.empty
- ContinueStat{} -> Set.empty
+ BreakStat{} -> emptyUniqDSet
+ ContinueStat{} -> emptyUniqDSet
{-# INLINE identsE #-}
-identsE :: JExpr -> Set Ident
+identsE :: JExpr -> UniqDSet Ident
identsE = \case
ValExpr v -> identsV v
SelExpr e _i -> identsE e -- do not rename properties
- IdxExpr e1 e2 -> identsE e1 <> identsE e2
- InfixExpr _ e1 e2 -> identsE e1 <> identsE e2
+ IdxExpr e1 e2 -> identsE e1 `unionUniqDSets` identsE e2
+ InfixExpr _ e1 e2 -> identsE e1 `unionUniqDSets` identsE e2
UOpExpr _ e -> identsE e
- IfExpr e1 e2 e3 -> identsE e1 <> identsE e2 <> identsE e3
- ApplExpr e es -> identsE e <> foldl' (<>) Set.empty (map identsE es)
+ IfExpr e1 e2 e3 -> identsE e1 `unionUniqDSets` identsE e2 `unionUniqDSets` identsE e3
+ ApplExpr e es -> identsE e `unionUniqDSets` foldl' unionUniqDSets emptyUniqDSet (map identsE es)
UnsatExpr{} -> error "identsE: UnsatExpr"
{-# INLINE identsV #-}
-identsV :: JVal -> Set Ident
+identsV :: JVal -> UniqDSet Ident
identsV = \case
- JVar i -> Set.singleton i
- JList xs -> foldl' (<>) Set.empty (map identsE xs)
- JDouble{} -> Set.empty
- JInt{} -> Set.empty
- JStr{} -> Set.empty
- JRegEx{} -> Set.empty
+ JVar i -> unitUniqDSet i
+ JList xs -> foldl' unionUniqDSets emptyUniqDSet (map identsE xs)
+ JDouble{} -> emptyUniqDSet
+ JInt{} -> emptyUniqDSet
+ JStr{} -> emptyUniqDSet
+ JRegEx{} -> emptyUniqDSet
-- nonDetEltsUniqMap doesn't introduce non-determinism because the Set ignores
-- the List's ordering in favour of lexical comparisons
- JHash m -> foldl' (<>) Set.empty (map (identsE . snd) $ nonDetEltsUniqMap m)
- JFunc args s -> Set.fromList args <> identsS s
+ -- foldl' (<>) Set.empty (map (identsE . snd) $ nonDetEltsUniqMap m)
+ JHash m -> foldUFM unionUniqDSets emptyUniqDSet (mapUFM snd . getUniqMap $ mapUniqMap identsE m)
+ JFunc args s -> mkUniqDSet args `unionUniqDSets` identsS s
UnsatVal{} -> error "identsV: UnsatVal"
=====================================
compiler/GHC/StgToJS/Linker/Compactor.hs
=====================================
@@ -60,7 +60,6 @@ import Data.Map (Map)
import Data.Int
import qualified Data.List as List
import Data.Maybe
-import qualified Data.Set as S
import GHC.Data.FastString
import GHC.JS.Syntax
@@ -451,7 +450,7 @@ buildFunId i = TxtI (mkFastString $ "h$$$f" ++ show i)
-- result is ordered, does not contain duplicates
findGlobals :: UniqSet FastString -> JStat -> [FastString]
-findGlobals globals stat = filter isGlobal . map itxt . S.toList $ identsS stat
+findGlobals globals stat = filter isGlobal . map itxt . uniqDSetToList $ identsS stat
where
locals = mkUniqSet (findLocals stat)
isGlobal i = elementOfUniqSet i globals && not (elementOfUniqSet i locals)
@@ -787,7 +786,7 @@ findDefinitions _ = []
hashSingleDefinition :: UniqSet FastString -> Ident -> JExpr -> (FastString, HashBuilder)
hashSingleDefinition globals (TxtI i) expr = (i, ht 0 <> render st <> mconcat (map hobj globalRefs))
where
- globalRefs = filter (`elementOfUniqSet` globals) . map itxt $ S.toList (identsE expr)
+ globalRefs = filter (`elementOfUniqSet` globals) . map itxt $ uniqDSetToList (identsE expr)
globalMap = listToUniqMap $ zip globalRefs (map (mkFastString . ("h$$$global_"++) . show) [(1::Int)..])
expr' = identsE' (\i@(TxtI t) -> maybe i TxtI (lookupUniqMap globalMap t)) expr
st = AssignStat (ValExpr (JVar (TxtI "dummy"))) expr'
=====================================
compiler/GHC/StgToJS/Monad.hs
=====================================
@@ -45,6 +45,8 @@ import qualified Data.Set as S
import qualified Data.List as L
import Data.Function
+import GHC.Types.Unique.DSet
+
runG :: StgToJSConfig -> Module -> UniqFM Id CgStgExpr -> G a -> IO a
runG config m unfloat action = State.evalStateT action (initState config m unfloat)
@@ -153,9 +155,9 @@ setGlobalIdCache v = State.modify (\s -> s { gsGroup = (gsGroup s) { ggsGlobalId
liftToGlobal :: JStat -> G [(Ident, Id)]
liftToGlobal jst = do
GlobalIdCache gidc <- getGlobalIdCache
- let sids = S.filter (`M.member` gidc) (identsS jst)
- cnt = M.fromListWith (+) (map (,(1::Integer)) $ S.toList sids)
- sids' = L.sortBy (compare `on` (cnt M.!)) (nub' $ S.toList sids)
+ let sids = filterUniqDSet (`M.member` gidc) (identsS jst)
+ cnt = M.fromListWith (+) (map (,(1::Integer)) $ uniqDSetToList sids)
+ sids' = L.sortBy (compare `on` (cnt M.!)) (nub' $ uniqDSetToList sids)
pure $ map (\s -> (s, snd $ gidc M.! s)) sids'
nub' :: (Ord a, Eq a) => [a] -> [a]
=====================================
compiler/GHC/Types/Unique/Map.hs
=====================================
@@ -59,7 +59,7 @@ import Data.Maybe
import Data.Data
-- | Maps indexed by 'Uniquable' keys
-newtype UniqMap k a = UniqMap (UniqFM k (k, a))
+newtype UniqMap k a = UniqMap { getUniqMap :: UniqFM k (k, a) }
deriving (Data, Eq, Functor)
type role UniqMap nominal representational
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b679d7965b40e43a8db532d71e423e27cfdd2690
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b679d7965b40e43a8db532d71e423e27cfdd2690
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220927/f41df808/attachment-0001.html>
More information about the ghc-commits
mailing list