[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Update the outdated instructions in HACKING.md on how to compile GHC
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Jun 9 08:16:59 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
567b32e1 by David Binder at 2023-06-08T18:41:29-04:00
Update the outdated instructions in HACKING.md on how to compile GHC
- - - - -
b93168d7 by Ryan Scott at 2023-06-09T04:16:50-04:00
Restore mingwex dependency on Windows
This partially reverts some of the changes in !9475 to make `base` and
`ghc-prim` depend on the `mingwex` library on Windows. It also restores the
RTS's stubs for `mingwex`-specific symbols such as `_lock_file`.
This is done because the C runtime provides `libmingwex` nowadays, and
moreoever, not linking against `mingwex` requires downstream users to link
against it explicitly in difficult-to-predict circumstances. Better to always
link against `mingwex` and prevent users from having to do the guesswork
themselves.
See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for
the discussion that led to this.
- - - - -
548a4b8a by Ryan Scott at 2023-06-09T04:16:50-04:00
RtsSymbols.c: Remove mingwex symbol stubs
As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows,
which means that the RTS no longer needs to declare stubs for the `__mingw_*`
family of symbols. Let's remove these stubs to avoid confusion.
Fixes #23309.
- - - - -
adb2a55a by Ryan Scott at 2023-06-09T04:16:50-04:00
Consistently use validity checks for TH conversion of data constructors
We were checking that TH-spliced data declarations do not look like this:
```hs
data D :: Type = MkD Int
```
But we were only doing so for `data` declarations' data constructors, not for
`newtype`s, `data instance`s, or `newtype instance`s. This patch factors out
the necessary validity checks into its own `cvtDataDefnCons` function and uses
it in all of the places where it needs to be.
Fixes #22559.
- - - - -
14 changed files:
- HACKING.md
- compiler/GHC/ThToHs.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- configure.ac
- libraries/base/base.cabal
- libraries/ghc-prim/ghc-prim.cabal
- rts/RtsSymbols.c
- + testsuite/tests/th/T22559a.hs
- + testsuite/tests/th/T22559a.stderr
- + testsuite/tests/th/T22559b.hs
- + testsuite/tests/th/T22559b.stderr
- + testsuite/tests/th/T22559c.hs
- + testsuite/tests/th/T22559c.stderr
- testsuite/tests/th/all.T
Changes:
=====================================
HACKING.md
=====================================
@@ -23,47 +23,15 @@ Contributing patches to GHC in a hurry
======================================
Make sure your system has the necessary tools to compile GHC. You can
-find an overview here:
+find an overview of how to prepare your system for compiling GHC here:
<https://gitlab.haskell.org/ghc/ghc/wikis/building/preparation>
-Next, clone the repository and all the associated libraries:
+After you have prepared your system, you can build GHC following the instructions described here:
-```
-$ git clone --recursive git at gitlab.haskell.org:ghc/ghc.git
-```
+<https://gitlab.haskell.org/ghc/ghc/-/wikis/building/hadrian>
-On Windows, you need an extra repository containing some build tools.
-These can be downloaded for you by `configure`. This only needs to be done once by running:
-
-```
-$ ./configure --enable-tarballs-autodownload
-```
-
-First copy `mk/build.mk.sample` to `mk/build.mk` and ensure it has
-your preferred build settings. (You probably want to at least set
-`BuildFlavour` to `quick`):
-
-```
-$ cp mk/build.mk.sample mk/build.mk
-$ ... double-check mk/build.mk ...
-```
-
-Now build. The convenient `validate` script will build the tree in a way which
-is both quick to build and consistent with our testsuite:
-
-```
-$ ./validate --build-only
-```
-
-You can use the `_validatebuild/stage1/bin/ghc` binary to play with the
-newly built compiler.
-
-Now, hack on your copy and rebuild (with `make`) as necessary.
-
-Then start by making your commits however you want. When you're done, you can submit
-a pull request on Github for small changes. For larger changes the patch needs to be
-submitted to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review.
+Then start by making your commits however you want. When you're done, you can submit a merge request to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review.
Changes to the `base` library require a proposal to the [core libraries committee](https://github.com/haskell/core-libraries-committee/issues).
The GHC Wiki has a good summary for the [overall process](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs). One or several reviewers will review your PR, and when they are ok with your changes, they will assign the PR to [Marge Bot](https://gitlab.haskell.org/marge-bot) which will automatically rebase, batch and then merge your PR (assuming the build passes).
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -277,17 +277,13 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs)
cvtDec (NewtypeD ctxt tc tvs ksig constr derivs)
= do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
; ksig' <- cvtKind `traverse` ksig
- ; let first_datacon =
- case get_cons_names constr of
- [] -> panic "cvtDec: empty list of constructors"
- c:_ -> c
- ; con' <- cvtConstr first_datacon cNameN constr
+ ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr
; derivs' <- cvtDerivs derivs
; let defn = HsDataDefn { dd_ext = noExtField
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
- , dd_cons = NewTypeCon con'
+ , dd_cons = con'
, dd_derivs = derivs' }
; returnJustLA $ TyClD noExtField $
DataDecl { tcdDExt = noAnn
@@ -353,17 +349,13 @@ cvtDec (DataFamilyD tc tvs kind)
cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs)
= do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys
; ksig' <- cvtKind `traverse` ksig
- ; let first_datacon =
- case get_cons_names $ head constrs of
- [] -> panic "cvtDec: empty list of constructors"
- c:_ -> c
- ; cons' <- mapM (cvtConstr first_datacon cNameN) constrs
+ ; cons' <- cvtDataDefnCons False ksig $ DataTypeCons False constrs
; derivs' <- cvtDerivs derivs
; let defn = HsDataDefn { dd_ext = noExtField
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
- , dd_cons = DataTypeCons False cons'
+ , dd_cons = cons'
, dd_derivs = derivs' }
; returnJustLA $ InstD noExtField $ DataFamInstD
@@ -379,17 +371,14 @@ cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs)
cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs)
= do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys
; ksig' <- cvtKind `traverse` ksig
- ; let first_datacon =
- case get_cons_names constr of
- [] -> panic "cvtDec: empty list of constructors"
- c:_ -> c
- ; con' <- cvtConstr first_datacon cNameN constr
+ ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr
; derivs' <- cvtDerivs derivs
; let defn = HsDataDefn { dd_ext = noExtField
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
- , dd_cons = NewTypeCon con', dd_derivs = derivs' }
+ , dd_cons = con'
+ , dd_derivs = derivs' }
; returnJustLA $ InstD noExtField $ DataFamInstD
{ dfid_ext = noExtField
, dfid_inst = DataFamInstDecl { dfid_eqn =
@@ -498,6 +487,28 @@ cvtGenDataDec :: Bool -> TH.Cxt -> TH.Name -> [TH.TyVarBndr TH.BndrVis]
-> Maybe TH.Kind -> [TH.Con] -> [TH.DerivClause]
-> CvtM (Maybe (LHsDecl GhcPs))
cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs
+ = do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
+ ; ksig' <- cvtKind `traverse` ksig
+ ; cons' <- cvtDataDefnCons type_data ksig $
+ DataTypeCons type_data constrs
+ ; derivs' <- cvtDerivs derivs
+ ; let defn = HsDataDefn { dd_ext = noExtField
+ , dd_cType = Nothing
+ , dd_ctxt = mkHsContextMaybe ctxt'
+ , dd_kindSig = ksig'
+ , dd_cons = cons'
+ , dd_derivs = derivs' }
+ ; returnJustLA $ TyClD noExtField $
+ DataDecl { tcdDExt = noAnn
+ , tcdLName = tc', tcdTyVars = tvs'
+ , tcdFixity = Prefix
+ , tcdDataDefn = defn } }
+
+-- Convert a set of data constructors.
+cvtDataDefnCons ::
+ Bool -> Maybe TH.Kind ->
+ DataDefnCons TH.Con -> CvtM (DataDefnCons (LConDecl GhcPs))
+cvtDataDefnCons type_data ksig constrs
= do { let isGadtCon (GadtC _ _ _) = True
isGadtCon (RecGadtC _ _ _) = True
isGadtCon (ForallC _ _ c) = isGadtCon c
@@ -515,27 +526,16 @@ cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs
(failWith CannotMixGADTConsWith98Cons)
; unless (isNothing ksig || isGadtDecl)
(failWith KindSigsOnlyAllowedOnGADTs)
- ; (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
- ; ksig' <- cvtKind `traverse` ksig
; let first_datacon =
- case get_cons_names $ head constrs of
- [] -> panic "cvtGenDataDec: empty list of constructors"
+ case firstDataDefnCon constrs of
+ Nothing -> panic "cvtDataDefnCons: empty list of constructors"
+ Just con -> con
+ first_datacon_name =
+ case get_cons_names first_datacon of
+ [] -> panic "cvtDataDefnCons: data constructor with no names"
c:_ -> c
- ; cons' <- mapM (cvtConstr first_datacon con_name) constrs
-
- ; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExtField
- , dd_cType = Nothing
- , dd_ctxt = mkHsContextMaybe ctxt'
- , dd_kindSig = ksig'
- , dd_cons = DataTypeCons type_data cons'
- , dd_derivs = derivs' }
- ; returnJustLA $ TyClD noExtField $
- DataDecl { tcdDExt = noAnn
- , tcdLName = tc', tcdTyVars = tvs'
- , tcdFixity = Prefix
- , tcdDataDefn = defn } }
+ ; mapM (cvtConstr first_datacon_name con_name) constrs }
----------------
cvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn GhcPs)
=====================================
compiler/Language/Haskell/Syntax/Decls.hs
=====================================
@@ -30,7 +30,7 @@ module Language.Haskell.Syntax.Decls (
HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..),
HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys,
NewOrData(..), DataDefnCons(..), dataDefnConsNewOrData,
- isTypeDataDefnCons,
+ isTypeDataDefnCons, firstDataDefnCon,
StandaloneKindSig(..), LStandaloneKindSig,
-- ** Class or type declarations
@@ -1040,6 +1040,11 @@ isTypeDataDefnCons :: DataDefnCons a -> Bool
isTypeDataDefnCons (NewTypeCon _) = False
isTypeDataDefnCons (DataTypeCons is_type_data _) = is_type_data
+-- | Retrieve the first data constructor in a 'DataDefnCons' (if one exists).
+firstDataDefnCon :: DataDefnCons a -> Maybe a
+firstDataDefnCon (NewTypeCon con) = Just con
+firstDataDefnCon (DataTypeCons _ cons) = listToMaybe cons
+
-- | Located data Constructor Declaration
type LConDecl pass = XRec pass (ConDecl pass)
-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when
=====================================
configure.ac
=====================================
@@ -917,6 +917,9 @@ AC_CHECK_DECLS([program_invocation_short_name], , ,
[#define _GNU_SOURCE 1
#include <errno.h>])
+dnl ** check for mingwex library
+AC_CHECK_LIB([mingwex],[closedir])
+
dnl ** check for math library
dnl Keep that check as early as possible.
dnl as we need to know whether we need libm
=====================================
libraries/base/base.cabal
=====================================
@@ -398,6 +398,7 @@ Library
if os(windows)
-- Windows requires some extra libraries for linking because the RTS
-- is no longer re-exporting them.
+ -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt.
-- mingw32: Unfortunately required because of a resource leak between
-- mingwex and mingw32. the __math_err symbol is defined in
-- mingw32 which is required by mingwex.
@@ -410,7 +411,7 @@ Library
-- advapi32: provides advanced kernel functions
extra-libraries:
wsock32, user32, shell32, mingw32, kernel32, advapi32,
- ws2_32, shlwapi, ole32, rpcrt4, ntdll
+ mingwex, ws2_32, shlwapi, ole32, rpcrt4, ntdll
-- Minimum supported Windows version.
-- These numbers can be found at:
-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx
=====================================
libraries/ghc-prim/ghc-prim.cabal
=====================================
@@ -68,12 +68,13 @@ Library
-- is no longer re-exporting them (see #11223)
-- ucrt: standard C library. The RTS will automatically include this,
-- but is added for completeness.
+ -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt.
-- mingw32: Unfortunately required because of a resource leak between
-- mingwex and mingw32. the __math_err symbol is defined in
-- mingw32 which is required by mingwex.
-- user32: provides access to apis to modify user components (UI etc)
-- on Windows. Required because of mingw32.
- extra-libraries: user32, mingw32, ucrt
+ extra-libraries: user32, mingw32, mingwex, ucrt
if os(linux)
-- we need libm, but for musl and other's we might need libc, as libm
=====================================
rts/RtsSymbols.c
=====================================
@@ -113,6 +113,26 @@ extern char **environ;
* by the RtsSymbols entry. To avoid this we introduce a horrible special case
* in `ghciInsertSymbolTable`, ensure that `atexit` is never overridden.
*/
+/*
+ * Note [Symbols for MinGW's printf]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * The printf offered by Microsoft's libc implementation, msvcrt, is quite
+ * incomplete, lacking support for even %ull. Consequently mingw-w64 offers its
+ * own implementation which we enable. However, to be thread-safe the
+ * implementation uses _lock_file. This would be fine except msvcrt.dll doesn't
+ * export _lock_file, only numbered versions do (e.g. msvcrt90.dll).
+ *
+ * To work around this mingw-w64 packages a static archive of msvcrt which
+ * includes their own implementation of _lock_file. However, this means that
+ * the archive contains things which the dynamic library does not; consequently
+ * we need to ensure that the runtime linker provides this symbol.
+ *
+ * It's all just so terrible.
+ *
+ * See also:
+ * https://sourceforge.net/p/mingw-w64/wiki2/gnu%20printf/
+ * https://sourceforge.net/p/mingw-w64/discussion/723797/thread/55520785/
+ */
/* Note [_iob_func symbol]
* ~~~~~~~~~~~~~~~~~~~~~~~
* Microsoft in VS2013 to VS2015 transition made a backwards incompatible change
@@ -150,17 +170,17 @@ extern char **environ;
SymI_NeedsProto(__mingw_module_is_dll) \
RTS_WIN32_ONLY(SymI_NeedsProto(___chkstk_ms)) \
RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms)) \
- SymI_HasProto(__mingw_vsnwprintf) \
- /* ^^ Need to figure out why this is needed. */ \
+ RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf_s)) \
+ RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf)) \
+ RTS_WIN64_ONLY(SymI_HasProto(_errno)) \
+ /* see Note [Symbols for MinGW's printf] */ \
+ SymI_HasProto(_lock_file) \
+ SymI_HasProto(_unlock_file) \
/* See Note [_iob_func symbol] */ \
RTS_WIN64_ONLY(SymI_HasProto_redirect( \
__imp___acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \
RTS_WIN32_ONLY(SymI_HasProto_redirect( \
- __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \
- SymI_HasProto(__mingw_vsnwprintf) \
- /* ^^ Need to figure out why this is needed. */ \
- SymI_HasProto(__mingw_vfprintf) \
- /* ^^ Need to figure out why this is needed. */
+ __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA))
#else
#define RTS_MINGW_ONLY_SYMBOLS /**/
#endif
=====================================
testsuite/tests/th/T22559a.hs
=====================================
@@ -0,0 +1,13 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TemplateHaskell #-}
+module T22559a where
+
+import Language.Haskell.TH
+
+$(pure [NewtypeD
+ [] (mkName "D") [] (Just StarT)
+ (NormalC (mkName "MkD")
+ [( Bang NoSourceUnpackedness NoSourceStrictness
+ , ConT ''Int
+ )])
+ []])
=====================================
testsuite/tests/th/T22559a.stderr
=====================================
@@ -0,0 +1,4 @@
+
+T22559a.hs:7:2: error: [GHC-40746]
+ Kind signatures are only allowed on GADTs
+ When splicing a TH declaration: newtype D :: * = MkD GHC.Types.Int
=====================================
testsuite/tests/th/T22559b.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+module T22559b where
+
+import Language.Haskell.TH
+
+data family D
+
+$(pure [DataInstD
+ [] Nothing
+ (ConT (mkName "D")) (Just StarT)
+ [NormalC (mkName "MkD")
+ [( Bang NoSourceUnpackedness NoSourceStrictness
+ , ConT ''Int
+ )]]
+ []])
=====================================
testsuite/tests/th/T22559b.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T22559b.hs:10:2: error: [GHC-40746]
+ Kind signatures are only allowed on GADTs
+ When splicing a TH declaration:
+ data instance D :: * = MkD GHC.Types.Int
=====================================
testsuite/tests/th/T22559c.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+module T22559c where
+
+import Language.Haskell.TH
+
+data family D
+
+$(pure [NewtypeInstD
+ [] Nothing
+ (ConT (mkName "D")) (Just StarT)
+ (NormalC (mkName "MkD")
+ [( Bang NoSourceUnpackedness NoSourceStrictness
+ , ConT ''Int
+ )])
+ []])
=====================================
testsuite/tests/th/T22559c.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T22559c.hs:10:2: error: [GHC-40746]
+ Kind signatures are only allowed on GADTs
+ When splicing a TH declaration:
+ newtype instance D :: * = MkD GHC.Types.Int
=====================================
testsuite/tests/th/all.T
=====================================
@@ -573,3 +573,6 @@ test('TH_typed3', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('TH_typed4', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('TH_typed5', normal, compile_and_run, [''])
test('T21050', normal, compile_fail, [''])
+test('T22559a', normal, compile_fail, [''])
+test('T22559b', normal, compile_fail, [''])
+test('T22559c', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e44b3f11af040fcabd7453cdbe3e5e0e34165ff...adb2a55afab372abea97365bf4f97074d921e6f5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e44b3f11af040fcabd7453cdbe3e5e0e34165ff...adb2a55afab372abea97365bf4f97074d921e6f5
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/20230609/84ffa375/attachment-0001.html>
More information about the ghc-commits
mailing list