[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: distrib: Rediscover otool and install_name_tool on Darwin

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Nov 29 10:48:17 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
292983c8 by Ben Gamari at 2023-11-28T22:44:28-05:00
distrib: Rediscover otool and install_name_tool on Darwin

In the bindist configure script we must rediscover the `otool` and
`install_name_tool`s since they may be different from the build
environment.

Fixes #24211.

- - - - -
dfe1c354 by Stefan Schulze Frielinghaus at 2023-11-28T22:45:04-05:00
llvmGen: Align objects in the data section

Objects in the data section may be referenced via tagged pointers.
Thus, align those objects to a 4- or 8-byte boundary for 32- or 64-bit
platforms, respectively.  Note, this may need to be reconsidered if
objects with a greater natural alignment requirement are emitted as e.g.
128-bit atomics.

Fixes #24163.

- - - - -
4a78c2aa by Matthew Pickering at 2023-11-29T05:48:06-05:00
metrics: Widen libdir and size_hello_obj acceptance window

af8816740d9b8759be1a22af8adcb5f13edeb61d shows that the libdir size can
fluctuate quite significantly even when the change is quite small.
Therefore we widen the acceptance window to 10%.

- - - - -
855751a9 by Alan Zimmerman at 2023-11-29T05:48:06-05:00
EPA: Clean up TC Monad Utils

We no longer need the alternative variant of addLocM (addLocMA)
nor wrapLocAM, wrapLocSndMA.

aarch64-darwin
Metric Increase:
    MultiLayerModulesTH_OneShot

deb10-numa-slow
Metric Decrease:
    libdir

- - - - -


11 changed files:

- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Class.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
- distrib/configure.ac.in
- testsuite/tests/perf/size/all.T


Changes:

=====================================
compiler/GHC/CmmToLlvm/Data.hs
=====================================
@@ -89,6 +89,7 @@ genLlvmData (sec, CmmStaticsRaw lbl xs) = do
         align          = case sec of
                             Section CString _ -> if (platformArch platform == ArchS390X)
                                                     then Just 2 else Just 1
+                            Section Data _    -> Just $ platformWordSizeInBytes platform
                             _                 -> Nothing
         const          = if sectionProtection sec == ReadOnlySection
                             then Constant else Global


=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -459,7 +459,7 @@ rnBindLHS name_maker _ bind@(FunBind { fun_id = rdr_name })
 
 rnBindLHS name_maker _ (PatSynBind x psb at PSB{ psb_id = rdrname })
   | isTopRecNameMaker name_maker
-  = do { addLocMA checkConName rdrname
+  = do { addLocM checkConName rdrname
        ; name <-
            lookupLocatedTopConstructorRnN rdrname -- Should be in scope already
        ; return (PatSynBind x psb{ psb_ext = noAnn, psb_id = name }) }


=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -276,7 +276,7 @@ rnSrcWarnDecls bndr_set decls'
        ; mapM_ (\ dups -> let ((L loc rdr) :| (lrdr':_)) = dups
                           in addErrAt (locA loc) (TcRnDuplicateWarningDecls lrdr' rdr))
                warn_rdr_dups
-       ; pairs_s <- mapM (addLocMA rn_deprec) decls
+       ; pairs_s <- mapM (addLocM rn_deprec) decls
        ; return $ concat pairs_s }
  where
    decls = concatMap (wd_warnings . unLoc) decls'
@@ -1891,7 +1891,7 @@ rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = cond
       = do { unlessXOptM LangExt.TypeData $ failWith TcRnIllegalTypeData
            ; unless (null (fromMaybeContext context)) $
                failWith $ TcRnTypeDataForbids TypeDataForbidsDatatypeContexts
-           ; mapM_ (addLocMA check_type_data_condecl) condecls
+           ; mapM_ (addLocM check_type_data_condecl) condecls
            ; unless (null derivs) $
                failWith $ TcRnTypeDataForbids TypeDataForbidsDerivingClauses
            }
@@ -2384,7 +2384,7 @@ rnConDecl :: ConDecl GhcPs -> RnM (ConDecl GhcRn, FreeVars)
 rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
                            , con_mb_cxt = mcxt, con_args = args
                            , con_doc = mb_doc, con_forall = forall_ })
-  = do  { _        <- addLocMA checkConName name
+  = do  { _        <- addLocM checkConName name
         ; new_name <- lookupLocatedTopConstructorRnN name
 
         -- We bind no implicit binders here; this is just like
@@ -2421,7 +2421,7 @@ rnConDecl (ConDeclGADT { con_names   = names
                        , con_g_args  = args
                        , con_res_ty  = res_ty
                        , con_doc     = mb_doc })
-  = do  { mapM_ (addLocMA checkConName) names
+  = do  { mapM_ (addLocM checkConName) names
         ; new_names <- mapM (lookupLocatedTopConstructorRnN) names
 
         ; let -- We must ensure that we extract the free tkvs in left-to-right


=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -223,7 +223,7 @@ tcCompleteSigs sigs =
       -- compatible with the result type constructor 'mb_tc'.
       doOne (L loc c@(CompleteMatchSig (_ext, _src_txt) (L _ ns) mb_tc_nm))
         = fmap Just $ setSrcSpanA loc $ addErrCtxt (text "In" <+> ppr c) $ do
-            cls   <- mkUniqDSet <$> mapM (addLocMA tcLookupConLike) ns
+            cls   <- mkUniqDSet <$> mapM (addLocM tcLookupConLike) ns
             mb_tc <- traverse @Maybe tcLookupLocatedTyCon mb_tc_nm
             pure CompleteMatch { cmConLikes = cls, cmResultTyCon = mb_tc }
       doOne _ = return Nothing
@@ -239,7 +239,7 @@ tcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id]
 tcHsBootSigs binds sigs
   = do  { unless (null binds) $
             rejectBootDecls HsBoot BootBindsRn (concatMap (bagToList . snd) binds)
-        ; concatMapM (addLocMA tc_boot_sig) (filter isTypeLSig sigs) }
+        ; concatMapM (addLocM tc_boot_sig) (filter isTypeLSig sigs) }
   where
     tc_boot_sig (TypeSig _ lnames hs_ty) = mapM f lnames
       where


=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -1516,7 +1516,7 @@ inferInitialKinds decls
        ; traceTc "inferInitialKinds done }" empty
        ; return tcs }
   where
-    infer_initial_kind = addLocMA (getInitialKind InitialKindInfer)
+    infer_initial_kind = addLocM (getInitialKind InitialKindInfer)
 
 -- Check type/class declarations against their standalone kind signatures or
 -- CUSKs, producing a generalized TcTyCon for each.
@@ -1528,7 +1528,7 @@ checkInitialKinds decls
        ; return tcs }
   where
     check_initial_kind (ldecl, msig) =
-      addLocMA (getInitialKind (InitialKindCheck msig)) ldecl
+      addLocM (getInitialKind (InitialKindCheck msig)) ldecl
 
 -- | Get the initial kind of a TyClDecl, either generalized or non-generalized,
 -- depending on the 'InitialKindStrategy'.
@@ -1556,7 +1556,7 @@ getInitialKind strategy
             -- See Note [Don't process associated types in getInitialKind]
 
        ; at_tcs <- tcExtendTyVarEnv (tyConTyVars cls_tc) $
-                      mapM (addLocMA (getAssocFamInitialKind cls_tc)) ats
+                      mapM (addLocM (getAssocFamInitialKind cls_tc)) ats
        ; return (cls_tc : at_tcs) }
   where
     getAssocFamInitialKind cls =
@@ -2621,7 +2621,7 @@ tcClassDecl1 roles_info class_name hs_ctxt meths fundeps sigs ats at_defs
                -- The (binderVars tc_bndrs) is needed bring into scope the
                -- skolems bound by the class decl header (#17841)
                do { ctxt <- tcHsContext hs_ctxt
-                  ; fds  <- mapM (addLocMA tc_fundep) fundeps
+                  ; fds  <- mapM (addLocM tc_fundep) fundeps
                   ; sig_stuff <- tcClassSigs class_name sigs meths
                   ; at_stuff  <- tcClassATs class_name clas ats at_defs
                   ; return (ctxt, fds, sig_stuff, at_stuff) }
@@ -2724,7 +2724,7 @@ tcClassATs class_name cls ats at_defs
                                           (at_def_tycon at_def) [at_def])
                         emptyNameEnv at_defs
 
-    tc_at at = do { (fam_tc, val_infos) <- addLocMA (tcFamDecl1 (Just cls)) at
+    tc_at at = do { (fam_tc, val_infos) <- addLocM (tcFamDecl1 (Just cls)) at
                   ; mapM_ (checkTyFamEqnValidityInfo fam_tc) val_infos
                   ; let at_defs = lookupNameEnv at_defs_map (at_fam_name at)
                                   `orElse` []
@@ -3579,7 +3579,7 @@ tcConDecls :: DataDeclInfo
            -> DataDefnCons (LConDecl GhcRn) -> TcM (DataDefnCons DataCon)
 tcConDecls dd_info rep_tycon tmpl_bndrs res_kind
   = concatMapDataDefnConsTcM (tyConName rep_tycon) $ \ new_or_data ->
-    addLocMA $ tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind (mkTyConTagMap rep_tycon)
+    addLocM $ tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind (mkTyConTagMap rep_tycon)
     -- mkTyConTagMap: it's important that we pay for tag allocation here,
     -- once per TyCon. See Note [Constructor tag allocation], fixes #14657
 


=====================================
compiler/GHC/Tc/TyCl/Class.hs
=====================================
@@ -237,7 +237,7 @@ tcDefMeth :: Class -> [TyVar] -> EvVar -> LHsBinds GhcRn
 
 tcDefMeth _ _ _ _ _ prag_fn (sel_id, Nothing)
   = do { -- No default method
-         mapM_ (addLocMA (badDmPrag sel_id ))
+         mapM_ (addLocM (badDmPrag sel_id ))
                (lookupPragEnv prag_fn (idName sel_id))
        ; return emptyBag }
 


=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -2425,7 +2425,7 @@ Note that
 tcSpecInstPrags :: DFunId -> InstBindings GhcRn
                 -> TcM ([LTcSpecPrag], TcPragEnv)
 tcSpecInstPrags dfun_id (InstBindings { ib_binds = binds, ib_pragmas = uprags })
-  = do { spec_inst_prags <- mapM (wrapLocAM (tcSpecInst dfun_id)) $
+  = do { spec_inst_prags <- mapM (wrapLocM (tcSpecInst dfun_id)) $
                             filter isSpecInstLSig uprags
              -- The filter removes the pragmas for methods
        ; return (spec_inst_prags, mkPragEnv uprags binds) }


=====================================
compiler/GHC/Tc/Utils/Env.hs
=====================================
@@ -218,7 +218,7 @@ span of the Name.
 tcLookupLocatedGlobal :: LocatedA Name -> TcM TyThing
 -- c.f. GHC.IfaceToCore.tcIfaceGlobal
 tcLookupLocatedGlobal name
-  = addLocMA tcLookupGlobal name
+  = addLocM tcLookupGlobal name
 
 tcLookupGlobal :: Name -> TcM TyThing
 -- The Name is almost always an ExternalName, but not always
@@ -308,13 +308,13 @@ tcLookupAxiom name = do
         _           -> wrongThingErr WrongThingAxiom (AGlobal thing) name
 
 tcLookupLocatedGlobalId :: LocatedA Name -> TcM Id
-tcLookupLocatedGlobalId = addLocMA tcLookupId
+tcLookupLocatedGlobalId = addLocM tcLookupId
 
 tcLookupLocatedClass :: LocatedA Name -> TcM Class
-tcLookupLocatedClass = addLocMA tcLookupClass
+tcLookupLocatedClass = addLocM tcLookupClass
 
 tcLookupLocatedTyCon :: LocatedN Name -> TcM TyCon
-tcLookupLocatedTyCon = addLocMA tcLookupTyCon
+tcLookupLocatedTyCon = addLocM tcLookupTyCon
 
 -- Find the instance that exactly matches a type class application.  The class arguments must be precisely
 -- the same as in the instance declaration (modulo renaming & casts).
@@ -440,7 +440,7 @@ tcExtendRecEnv gbl_stuff thing_inside
 -}
 
 tcLookupLocated :: LocatedA Name -> TcM TcTyThing
-tcLookupLocated = addLocMA tcLookup
+tcLookupLocated = addLocM tcLookup
 
 tcLookupLcl_maybe :: Name -> TcM (Maybe TcTyThing)
 tcLookupLcl_maybe name


=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -61,9 +61,9 @@ module GHC.Tc.Utils.Monad(
   addDependentFiles,
 
   -- * Error management
-  getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM, addLocMA,
+  getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,
   inGeneratedCode, setInGeneratedCode,
-  wrapLocM, wrapLocAM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,
+  wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,
   wrapLocMA_,wrapLocMA,
   getErrsVar, setErrsVar,
   addErr,
@@ -995,18 +995,15 @@ setInGeneratedCode thing_inside =
 setSrcSpanA :: EpAnn ann -> TcRn a -> TcRn a
 setSrcSpanA l = setSrcSpan (locA l)
 
-addLocM :: (a -> TcM b) -> Located a -> TcM b
-addLocM fn (L loc a) = setSrcSpan loc $ fn a
+addLocM :: (HasLoc t) => (a -> TcM b) -> GenLocated t a -> TcM b
+addLocM fn (L loc a) = setSrcSpan (getHasLoc loc) $ fn a
 
-addLocMA :: (a -> TcM b) -> GenLocated (EpAnn ann) a -> TcM b
-addLocMA fn (L loc a) = setSrcSpanA loc $ fn a
-
-wrapLocM :: (a -> TcM b) -> Located a -> TcM (Located b)
-wrapLocM fn (L loc a) = setSrcSpan loc $ do { b <- fn a
-                                            ; return (L loc b) }
-
-wrapLocAM :: (a -> TcM b) -> LocatedAn an a -> TcM (Located b)
-wrapLocAM fn a = wrapLocM fn (reLoc a)
+wrapLocM :: (HasLoc t) =>  (a -> TcM b) -> GenLocated t a -> TcM (Located b)
+wrapLocM fn (L loc a) =
+  let
+    loc' = getHasLoc loc
+  in setSrcSpan loc' $ do { b <- fn a
+                          ; return (L loc' b) }
 
 wrapLocMA :: (a -> TcM b) -> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
 wrapLocMA fn (L loc a) = setSrcSpanA loc $ do { b <- fn a


=====================================
distrib/configure.ac.in
=====================================
@@ -206,6 +206,18 @@ dnl Identify C++ standard library flavour and location
 FP_FIND_CXX_STD_LIB
 AC_CONFIG_FILES([mk/system-cxx-std-lib-1.0.conf])
 
+dnl ** Which otool to use on macOS
+dnl --------------------------------------------------------------
+AC_CHECK_TARGET_TOOL([OTOOL], [otool])
+OtoolCmd="$OTOOL"
+AC_SUBST(OtoolCmd)
+
+dnl ** Which install_name_tool to use on macOS
+dnl --------------------------------------------------------------
+AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool])
+InstallNameToolCmd="$INSTALL_NAME_TOOL"
+AC_SUBST(InstallNameToolCmd)
+
 # Check that we have the same emsdk version as the one we were built with.
 ConfiguredEmsdkVersion=@ConfiguredEmsdkVersion@
 EMSDK_VERSION("", "", ${ConfiguredEmsdkVersion})


=====================================
testsuite/tests/perf/size/all.T
=====================================
@@ -1,3 +1,3 @@
-test('size_hello_obj', [collect_size(3, 'size_hello_obj.o')], compile, [''])
+test('size_hello_obj', [collect_size(5, 'size_hello_obj.o')], compile, [''])
 
-test('libdir',[stat_from_file('size', 3, 'SIZE')], makefile_test, ['libdir_size'] )
+test('libdir',[stat_from_file('size', 10, 'SIZE')], makefile_test, ['libdir_size'] )



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/27634ffe516db1c6862e0b6fbfb748878654b3e0...855751a97366e0f7d3e942bfbafb76c0863bca6d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/27634ffe516db1c6862e0b6fbfb748878654b3e0...855751a97366e0f7d3e942bfbafb76c0863bca6d
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/20231129/11700a02/attachment-0001.html>


More information about the ghc-commits mailing list