[Git][ghc/ghc][wip/fendor/os-string-modlocation] Introduce 'ModLocation' pattern synonym, fixed #24616
Hannes Siebenhandl (@fendor)
gitlab at gitlab.haskell.org
Wed May 29 14:55:42 UTC 2024
Hannes Siebenhandl pushed to branch wip/fendor/os-string-modlocation at Glasgow Haskell Compiler / GHC
Commits:
2676d340 by Fendor at 2024-05-29T16:55:01+02:00
Introduce 'ModLocation' pattern synonym, fixed #24616
Allows to maintain backwards compatibility and not breaking any
consumers of 'ModLocation'
- - - - -
4 changed files:
- compiler/GHC.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Module/Location.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -3,6 +3,7 @@
{-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables #-}
{-# LANGUAGE TupleSections, NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PatternSynonyms #-}
-- -----------------------------------------------------------------------------
--
@@ -76,12 +77,7 @@ module GHC (
ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
mgLookupModule,
ModSummary(..), ms_mod_name, ModLocation(..),
- ml_hs_file,
- ml_hi_file,
- ml_dyn_hi_file,
- ml_obj_file,
- ml_dyn_obj_file,
- ml_hie_file,
+ pattern ModLocation,
getModSummary,
getModuleGraph,
isLoaded,
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -2107,12 +2107,13 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs
rawCmms
return stub_c_exists
where
- no_loc = ModLocation{ ml_hs_file_ospath = Just $ unsafeEncodeUtf original_filename,
- ml_hi_file_ospath = panic "hscCompileCmmFile: no hi file",
- ml_obj_file_ospath = panic "hscCompileCmmFile: no obj file",
- ml_dyn_obj_file_ospath = panic "hscCompileCmmFile: no dyn obj file",
- ml_dyn_hi_file_ospath = panic "hscCompileCmmFile: no dyn obj file",
- ml_hie_file_ospath = panic "hscCompileCmmFile: no hie file"}
+ no_loc = OsPathModLocation
+ { ml_hs_file_ospath = Just $ unsafeEncodeUtf original_filename,
+ ml_hi_file_ospath = panic "hscCompileCmmFile: no hi file",
+ ml_obj_file_ospath = panic "hscCompileCmmFile: no obj file",
+ ml_dyn_obj_file_ospath = panic "hscCompileCmmFile: no dyn obj file",
+ ml_dyn_hi_file_ospath = panic "hscCompileCmmFile: no dyn obj file",
+ ml_hie_file_ospath = panic "hscCompileCmmFile: no hie file"}
-------------------- Stuff for new code gen ---------------------
@@ -2347,12 +2348,13 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
{- Desugar it -}
-- We use a basically null location for iNTERACTIVE
- let iNTERACTIVELoc = ModLocation{ ml_hs_file_ospath = Nothing,
- ml_hi_file_ospath = panic "hsDeclsWithLocation:ml_hi_file_ospath",
- ml_obj_file_ospath = panic "hsDeclsWithLocation:ml_obj_file_ospath",
- ml_dyn_obj_file_ospath = panic "hsDeclsWithLocation:ml_dyn_obj_file_ospath",
- ml_dyn_hi_file_ospath = panic "hsDeclsWithLocation:ml_dyn_hi_file_ospath",
- ml_hie_file_ospath = panic "hsDeclsWithLocation:ml_hie_file_ospath" }
+ let iNTERACTIVELoc = OsPathModLocation
+ { ml_hs_file_ospath = Nothing,
+ ml_hi_file_ospath = panic "hsDeclsWithLocation:ml_hi_file_ospath",
+ ml_obj_file_ospath = panic "hsDeclsWithLocation:ml_obj_file_ospath",
+ ml_dyn_obj_file_ospath = panic "hsDeclsWithLocation:ml_dyn_obj_file_ospath",
+ ml_dyn_hi_file_ospath = panic "hsDeclsWithLocation:ml_dyn_hi_file_ospath",
+ ml_hie_file_ospath = panic "hsDeclsWithLocation:ml_hie_file_ospath" }
ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv
{- Simplify -}
@@ -2631,12 +2633,13 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do
{- Lint if necessary -}
lintInteractiveExpr (text "hscCompileCoreExpr") hsc_env prepd_expr
- let this_loc = ModLocation{ ml_hs_file_ospath = Nothing,
- ml_hi_file_ospath = panic "hscCompileCoreExpr':ml_hi_file_ospath",
- ml_obj_file_ospath = panic "hscCompileCoreExpr':ml_obj_file_ospath",
- ml_dyn_obj_file_ospath = panic "hscCompileCoreExpr': ml_obj_file_ospath",
- ml_dyn_hi_file_ospath = panic "hscCompileCoreExpr': ml_dyn_hi_file_ospath",
- ml_hie_file_ospath = panic "hscCompileCoreExpr':ml_hie_file_ospath" }
+ let this_loc = OsPathModLocation
+ { ml_hs_file_ospath = Nothing,
+ ml_hi_file_ospath = panic "hscCompileCoreExpr':ml_hi_file_ospath",
+ ml_obj_file_ospath = panic "hscCompileCoreExpr':ml_obj_file_ospath",
+ ml_dyn_obj_file_ospath = panic "hscCompileCoreExpr': ml_obj_file_ospath",
+ ml_dyn_hi_file_ospath = panic "hscCompileCoreExpr': ml_dyn_hi_file_ospath",
+ ml_hie_file_ospath = panic "hscCompileCoreExpr':ml_hie_file_ospath" }
-- Ensure module uniqueness by giving it a name like "GhciNNNN".
-- This uniqueness is needed by the JS linker. Without it we break the 1-1
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -603,12 +603,12 @@ mkHomeModLocation2 fopts mod src_basename ext =
dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename
hie_fn = mkHiePath fopts src_basename mod_basename
- in (ModLocation{ ml_hs_file_ospath = Just (src_basename <.> ext),
- ml_hi_file_ospath = hi_fn,
- ml_dyn_hi_file_ospath = dyn_hi_fn,
- ml_obj_file_ospath = obj_fn,
- ml_dyn_obj_file_ospath = dyn_obj_fn,
- ml_hie_file_ospath = hie_fn })
+ in (OsPathModLocation{ ml_hs_file_ospath = Just (src_basename <.> ext),
+ ml_hi_file_ospath = hi_fn,
+ ml_dyn_hi_file_ospath = dyn_hi_fn,
+ ml_obj_file_ospath = obj_fn,
+ ml_dyn_obj_file_ospath = dyn_obj_fn,
+ ml_hie_file_ospath = hie_fn })
mkHomeModHiOnlyLocation :: FinderOpts
-> ModuleName
@@ -628,17 +628,17 @@ mkHiOnlyModLocation fopts hisuf dynhisuf path basename
obj_fn = mkObjPath fopts full_basename basename
dyn_obj_fn = mkDynObjPath fopts full_basename basename
hie_fn = mkHiePath fopts full_basename basename
- in ModLocation{ ml_hs_file_ospath = Nothing,
- ml_hi_file_ospath = full_basename <.> hisuf,
- -- Remove the .hi-boot suffix from
- -- hi_file, if it had one. We always
- -- want the name of the real .hi file
- -- in the ml_hi_file field.
- ml_dyn_obj_file_ospath = dyn_obj_fn,
- -- MP: TODO
- ml_dyn_hi_file_ospath = full_basename <.> dynhisuf,
- ml_obj_file_ospath = obj_fn,
- ml_hie_file_ospath = hie_fn
+ in OsPathModLocation{ ml_hs_file_ospath = Nothing,
+ ml_hi_file_ospath = full_basename <.> hisuf,
+ -- Remove the .hi-boot suffix from
+ -- hi_file, if it had one. We always
+ -- want the name of the real .hi file
+ -- in the ml_hi_file field.
+ ml_dyn_obj_file_ospath = dyn_obj_fn,
+ -- MP: TODO
+ ml_dyn_hi_file_ospath = full_basename <.> dynhisuf,
+ ml_obj_file_ospath = obj_fn,
+ ml_hie_file_ospath = hie_fn
}
-- | Constructs the filename of a .o file for a given source file.
=====================================
compiler/GHC/Unit/Module/Location.hs
=====================================
@@ -1,24 +1,23 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
-- | Module location
module GHC.Unit.Module.Location
- ( ModLocation(..)
+ ( ModLocation
+ ( ..
+ , ml_hs_file
+ , ml_hi_file
+ , ml_dyn_hi_file
+ , ml_obj_file
+ , ml_dyn_obj_file
+ , ml_hie_file
+ )
+ , pattern ModLocation
, addBootSuffix
, addBootSuffix_maybe
, addBootSuffixLocn_maybe
, addBootSuffixLocn
, addBootSuffixLocnOut
, removeBootSuffix
- , ml_hs_file
- , ml_hi_file
- , ml_dyn_hi_file
- , ml_obj_file
- , ml_dyn_obj_file
- , ml_hie_file
- , set_ml_hs_file
- , set_ml_hi_file
- , set_ml_dyn_hi_file
- , set_ml_obj_file
- , set_ml_dyn_obj_file
- , set_ml_hie_file
)
where
@@ -54,7 +53,7 @@ import qualified System.OsString as OsString
-- boot suffixes in mkOneShotModLocation.
data ModLocation
- = ModLocation {
+ = OsPathModLocation {
ml_hs_file_ospath :: Maybe OsPath,
-- ^ The source file, if we have one. Package modules
-- probably don't have source files.
@@ -83,6 +82,8 @@ data ModLocation
-- yet.
} deriving Show
+-- >>> :doc ml_hs_file
+
instance Outputable ModLocation where
ppr = text . show
@@ -133,38 +134,28 @@ addBootSuffixLocnOut locn
-- Helpers for backwards compatibility
-- ----------------------------------------------------------------------------
-ml_hs_file :: ModLocation -> Maybe FilePath
-ml_hs_file = fmap unsafeDecodeUtf . ml_hs_file_ospath
-
-ml_hi_file :: ModLocation -> FilePath
-ml_hi_file = unsafeDecodeUtf . ml_hi_file_ospath
-
-ml_dyn_hi_file :: ModLocation -> FilePath
-ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ospath
-
-ml_obj_file :: ModLocation -> FilePath
-ml_obj_file = unsafeDecodeUtf . ml_obj_file_ospath
-
-ml_dyn_obj_file :: ModLocation -> FilePath
-ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ospath
-
-ml_hie_file :: ModLocation -> FilePath
-ml_hie_file = unsafeDecodeUtf . ml_hie_file_ospath
-
-set_ml_hs_file :: Maybe FilePath -> ModLocation -> ModLocation
-set_ml_hs_file val ml = ml { ml_hs_file_ospath = fmap unsafeEncodeUtf val }
-
-set_ml_hi_file :: FilePath -> ModLocation -> ModLocation
-set_ml_hi_file val ml = ml { ml_hi_file_ospath = unsafeEncodeUtf val }
-
-set_ml_dyn_hi_file :: FilePath -> ModLocation -> ModLocation
-set_ml_dyn_hi_file val ml = ml { ml_dyn_hi_file_ospath = unsafeEncodeUtf val }
-
-set_ml_obj_file :: FilePath -> ModLocation -> ModLocation
-set_ml_obj_file val ml = ml { ml_obj_file_ospath = unsafeEncodeUtf val }
-
-set_ml_dyn_obj_file :: FilePath -> ModLocation -> ModLocation
-set_ml_dyn_obj_file val ml = ml { ml_dyn_obj_file_ospath = unsafeEncodeUtf val }
-
-set_ml_hie_file :: FilePath -> ModLocation -> ModLocation
-set_ml_hie_file val ml = ml { ml_hie_file_ospath = unsafeEncodeUtf val }
+pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
+pattern ModLocation
+ { ml_hs_file
+ , ml_hi_file
+ , ml_dyn_hi_file
+ , ml_obj_file
+ , ml_dyn_obj_file
+ , ml_hie_file
+ } <- OsPathModLocation
+ { ml_hs_file_ospath = (fmap unsafeDecodeUtf -> ml_hs_file)
+ , ml_hi_file_ospath = (unsafeDecodeUtf -> ml_hi_file)
+ , ml_dyn_hi_file_ospath = (unsafeDecodeUtf -> ml_dyn_hi_file)
+ , ml_obj_file_ospath = (unsafeDecodeUtf -> ml_obj_file)
+ , ml_dyn_obj_file_ospath = (unsafeDecodeUtf -> ml_dyn_obj_file)
+ , ml_hie_file_ospath = (unsafeDecodeUtf -> ml_hie_file)
+ } where
+ ModLocation ml_hs_file ml_hi_file ml_dyn_hi_file ml_obj_file ml_dyn_obj_file ml_hie_file
+ = OsPathModLocation
+ { ml_hs_file_ospath = fmap unsafeEncodeUtf ml_hs_file
+ , ml_hi_file_ospath = unsafeEncodeUtf ml_hi_file
+ , ml_dyn_hi_file_ospath = unsafeEncodeUtf ml_dyn_hi_file
+ , ml_obj_file_ospath = unsafeEncodeUtf ml_obj_file
+ , ml_dyn_obj_file_ospath = unsafeEncodeUtf ml_dyn_obj_file
+ , ml_hie_file_ospath = unsafeEncodeUtf ml_hie_file
+ }
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2676d34056fb597701fe834b540d1b0c0235590a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2676d34056fb597701fe834b540d1b0c0235590a
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/20240529/be95357c/attachment-0001.html>
More information about the ghc-commits
mailing list