diff options
| author | M Farkas-Dyck <strake888@proton.me> | 2022-09-19 01:00:06 -0800 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-10-18 03:35:38 -0400 |
| commit | 9ecd1ac03d9cd2eea8e2b50233a08fd3d9cca7c7 (patch) | |
| tree | a9bb516312a93f6f6743734e5df908577523e832 /compiler/GHC/Stg | |
| parent | 0ac6042302219b162a23b85f637bcc8fa27fafaa (diff) | |
| download | haskell-9ecd1ac03d9cd2eea8e2b50233a08fd3d9cca7c7.tar.gz | |
Make `Functor` a superclass of `TrieMap`, which lets us derive the `map` functions.
Diffstat (limited to 'compiler/GHC/Stg')
| -rw-r--r-- | compiler/GHC/Stg/CSE.hs | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/compiler/GHC/Stg/CSE.hs b/compiler/GHC/Stg/CSE.hs index a4d92ad500..73fb7617a0 100644 --- a/compiler/GHC/Stg/CSE.hs +++ b/compiler/GHC/Stg/CSE.hs @@ -117,6 +117,11 @@ data StgArgMap a = SAM , sam_lit :: LiteralMap a } +-- TODO(22292): derive +instance Functor StgArgMap where + fmap f SAM { sam_var = varm, sam_lit = litm } = SAM + { sam_var = fmap f varm, sam_lit = fmap f litm } + instance TrieMap StgArgMap where type Key StgArgMap = StgArg emptyTM = SAM { sam_var = emptyTM @@ -126,13 +131,16 @@ instance TrieMap StgArgMap where alterTM (StgVarArg var) f m = m { sam_var = sam_var m |> xtDFreeVar var f } alterTM (StgLitArg lit) f m = m { sam_lit = sam_lit m |> alterTM lit f } foldTM k m = foldTM k (sam_var m) . foldTM k (sam_lit m) - mapTM f (SAM {sam_var = varm, sam_lit = litm}) = - SAM { sam_var = mapTM f varm, sam_lit = mapTM f litm } filterTM f (SAM {sam_var = varm, sam_lit = litm}) = SAM { sam_var = filterTM f varm, sam_lit = filterTM f litm } newtype ConAppMap a = CAM { un_cam :: DNameEnv (ListMap StgArgMap a) } +-- TODO(22292): derive +instance Functor ConAppMap where + fmap f = CAM . fmap (fmap f) . un_cam + {-# INLINE fmap #-} + instance TrieMap ConAppMap where type Key ConAppMap = (DataCon, [StgArg]) emptyTM = CAM emptyTM @@ -140,8 +148,7 @@ instance TrieMap ConAppMap where alterTM (dataCon, args) f m = m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f } foldTM k = un_cam >.> foldTM (foldTM k) - mapTM f = un_cam >.> mapTM (mapTM f) >.> CAM - filterTM f = un_cam >.> mapTM (filterTM f) >.> CAM + filterTM f = un_cam >.> fmap (filterTM f) >.> CAM ----------------- -- The CSE Env -- |