[Git][ghc/ghc][wip/alpine-ci] 11 commits: Comments only: document newtypes' DataConWrapId
Ben Gamari
gitlab at gitlab.haskell.org
Tue Jun 11 21:24:54 UTC 2019
Ben Gamari pushed to branch wip/alpine-ci at Glasgow Haskell Compiler / GHC
Commits:
0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z
Comments only: document newtypes' DataConWrapId
- - - - -
58a5d728 by David Eichmann at 2019-06-11T03:52:50Z
Refactor the rules for .hi and .o into a single rule using `&%>` #16764
Currently the rule for .hi files just triggers (via need) the rule
for the .o file, and .o rule generates both the .o and .hi file.
Likewise for .o-boot and .hi-boot files. This is a bit of an abuse
of Shake, and in fact shake supports rules with multiple output
with the &%> function. This exact use case appears in Neil
Mitchell's paper *Shake Before Building* section 6.3.
- - - - -
2f945086 by Ben Gamari at 2019-06-11T03:53:25Z
testsuite: Fix and extend closure_size test
This was previously broken in several ways. This is fixed and it also
now tests arrays. Unfortunately I was unable to find a way to continue
testing PAP and FUN sizes; these simply depend too much upon the
behavior of the simplifier.
I also tried to extend this to test non-empty arrays as well but
unfortunately this was non-trivial as the array card size constant isn't
readily available from haskell.
Fixes #16531.
- - - - -
e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z
ghc-heap: Add closure_size_noopt test
This adds a new test, only run in the `normal` way, to verify the size
of FUNs and PAPs.
- - - - -
e7d9cd0a by Ben Gamari at 2019-06-11T21:24:43Z
gitlab-ci: Build alpine release bindists
- - - - -
aa4f1c89 by Ben Gamari at 2019-06-11T21:24:43Z
base/Event/Poll: Drop POLLRDHUP enum item
Previously the Event enumeration produced by hsc2hs would sometimes
include a currently-unused POLLRDHUP item. This unused binding would
result in a build failure. Drop it.
- - - - -
61a14107 by Ben Gamari at 2019-06-11T21:24:43Z
testsuite: Fix T8602 on musl
Musl wants hash-bangs on all executables.
- - - - -
c9b62b9f by Ben Gamari at 2019-06-11T21:24:44Z
testsuite: Ensure T5423 flushes C output buffer
Previously T5423 would fail to flush the printf output buffer.
Consequently it was platform-dependent whether the C or Haskell print
output would be emitted first.
- - - - -
4c0fdac0 by Ben Gamari at 2019-06-11T21:24:44Z
testsuite: Flush conc059's printf buffer
Otherwise it the order out the Haskell and C output will be
system-dependent.
- - - - -
1b181cdb by Ben Gamari at 2019-06-11T21:24:44Z
testsuite: Ensure that ffi005 output order is predictable
The libc output buffer wasn't being flushed, making the order
system-depedent.
- - - - -
915a7042 by Ben Gamari at 2019-06-11T21:24:44Z
XXX: Test alpine job
- - - - -
14 changed files:
- .gitlab-ci.yml
- compiler/basicTypes/MkId.hs
- hadrian/src/Rules/Compile.hs
- libraries/base/GHC/Event/Poll.hsc
- + libraries/ghc-heap/tests/ClosureSizeUtils.hs
- libraries/ghc-heap/tests/all.T
- libraries/ghc-heap/tests/closure_size.hs
- + libraries/ghc-heap/tests/closure_size_noopt.hs
- testsuite/tests/concurrent/should_run/conc059.stdout
- testsuite/tests/concurrent/should_run/conc059_c.c
- testsuite/tests/driver/T8602/T8602.script
- testsuite/tests/ffi/should_run/ffi005.hs
- testsuite/tests/rts/T5423.stdout
- testsuite/tests/rts/T5423_cmm.cmm
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -2,7 +2,7 @@ variables:
GIT_SSL_NO_VERIFY: "1"
# Commit of ghc/ci-images repository from which to pull Docker images
- DOCKER_REV: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f
+ DOCKER_REV: 6bcca6969aece60c4fc7aef2d17053146eda100e
# Sequential version number capturing the versions of all tools fetched by
# .gitlab/win32-init.sh.
@@ -535,6 +535,26 @@ release-x86_64-linux-deb8:
when: always
expire_in: 2 week
+#################################
+# x86_64-linux-alpine
+#################################
+
+release-x86_64-linux-alpine:
+ extends: .validate-linux
+ stage: lint
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV"
+ variables:
+ BUILD_SPHINX_PDF: "NO"
+ TEST_ENV: "x86_64-linux-alpine"
+ BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-alpine-linux.tar.xz"
+ # Can't use ld.gold due to #13958.
+ CONFIGURE_ARGS: "--disable-ld-override"
+ cache:
+ key: linux-x86_64-alpine
+ artifacts:
+ when: always
+ expire_in: 2 week
+
#################################
# x86_64-linux-centos7
#################################
=====================================
compiler/basicTypes/MkId.hs
=====================================
@@ -298,6 +298,24 @@ so the data constructor for T:C had a single argument, namely the
predicate (C a). But now we treat that as an ordinary argument, not
part of the theta-type, so all is well.
+Note [Newtype workers]
+~~~~~~~~~~~~~~~~~~~~~~
+A newtype does not really have a worker. Instead, newtype constructors
+just unfold into a cast. But we need *something* for, say, MkAge to refer
+to. So, we do this:
+
+* The Id used as the newtype worker will have a compulsory unfolding to
+ a cast. See Note [Compulsory newtype unfolding]
+
+* This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId,
+ as those have special treatment in the back end.
+
+* There is no top-level binding, because the compulsory unfolding
+ means that it will be inlined (to a cast) at every call site.
+
+We probably should have a NewtypeWorkId, but these Ids disappear as soon as
+we desugar anyway, so it seems a step too far.
+
Note [Compulsory newtype unfolding]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Newtype wrappers, just like workers, have compulsory unfoldings.
@@ -447,6 +465,8 @@ mkDataConWorkId :: Name -> DataCon -> Id
mkDataConWorkId wkr_name data_con
| isNewTyCon tycon
= mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info
+ -- See Note [Newtype workers]
+
| otherwise
= mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info
=====================================
hadrian/src/Rules/Compile.hs
=====================================
@@ -4,7 +4,7 @@ import Hadrian.BuildPath
import Hadrian.Oracles.TextFile
import Base
-import Context
+import Context as C
import Expression
import Rules.Generate
import Settings
@@ -30,16 +30,29 @@ compilePackage rs = do
--
-- and parse the information we need (stage, package path, ...) from
-- the path and figure out the suitable way to produce that object file.
- objectFilesUnder root |%> \path -> do
- obj <- parsePath (parseBuildObject root) "<object file path parser>" path
- compileObject rs path obj
+ alternatives $ do
+ -- Language is identified by subdirectory under /build.
+ -- These are non-haskell files so only have a .o or .<way>_o suffix.
+ [ root -/- "**/build/c/**/*." ++ wayPat ++ "o"
+ | wayPat <- wayPats] |%> compileNonHsObject rs C
+
+ [ root -/- "**/build/cmm/**/*." ++ wayPat ++ "o"
+ | wayPat <- wayPats] |%> compileNonHsObject rs Cmm
+
+ [ root -/- "**/build/s/**/*." ++ wayPat ++ "o"
+ | wayPat <- wayPats] |%> compileNonHsObject rs Asm
+
+ -- All else is haskell.
+ -- This comes last as it overlaps with the above rules' file patterns.
+ forM_ ((,) <$> hsExts <*> wayPats) $ \ ((oExt, hiExt), wayPat) ->
+ [ root -/- "**/build/**/*." ++ wayPat ++ oExt
+ , root -/- "**/build/**/*." ++ wayPat ++ hiExt ]
+ &%> \ [o, _hi] -> compileHsObjectAndHi rs o
where
- objectFilesUnder r = [ r -/- ("**/build/**/*" ++ pat)
- | pat <- extensionPats ]
-
- exts = [ "o", "hi", "o-boot", "hi-boot" ]
- patternsFor e = [ "." ++ e, ".*_" ++ e ]
- extensionPats = concatMap patternsFor exts
+ hsExts = [ ("o", "hi")
+ , ("o-boot", "hi-boot")
+ ]
+ wayPats = [ "", "*_" ]
-- * Object file paths types and parsers
@@ -153,67 +166,47 @@ objectContext (BuildPath _ stage pkgPath obj) =
-- * Building an object
-compileHsObject
- :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action ()
-compileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj =
- case hsobj of
- HsObject _basename (Extension way Hi ) -> need [objpath -<.> osuf way]
- HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way]
- HsObject _basename (Extension way suf) -> do
- let ctx = objectContext b
- ctxPath <- contextPath ctx
- (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath
- need (src:deps)
- needLibrary =<< contextDependencies ctx
-
- -- The .dependencies files only lists shallow dependencies. ghc will
- -- generally read more *.hi and *.hi-boot files (deep dependencies).
- -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#cloud-shared-cache-build)
- -- Note that this may allow too many *.hi and *.hi-boot files, but
- -- calculating the exact set of deep dependencies is not feasible.
- trackAllow [ "//*." ++ hisuf way
- , "//*." ++ hibootsuf way
- ]
-
- buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath]
- -- Andrey: It appears that the previous refactoring has broken
- -- multiple-output build rules. Ideally, we should bring multiple-output
- -- rules back, see: https://github.com/snowleopard/hadrian/issues/216.
- -- As a temporary solution, I'm using Shake's new 'produces' feature to
- -- record that this rule also produces a corresponding interface file.
- let hi | suf == O = objpath -<.> hisuf way
- | suf == OBoot = objpath -<.> hibootsuf way
- | otherwise = error "Internal error: unknown Haskell object extension"
- produces [hi]
-
-compileNonHsObject
- :: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject
- -> Action ()
-compileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj =
- case nonhsobj of
- NonHsObject lang _basename _way ->
- go (builderFor lang) (toSrcFor lang)
-
- where builderFor C = Ghc CompileCWithGhc
- builderFor _ = Ghc CompileHs
-
- toSrcFor Asm = obj2src "S" (const False)
- toSrcFor C = obj2src "c" (const False)
- toSrcFor Cmm = obj2src "cmm" isGeneratedCmmFile
-
- go builder tosrc = do
- let ctx = objectContext b
- src <- tosrc ctx objpath
- need [src]
- needDependencies ctx src (objpath <.> "d")
- buildWithResources rs $ target ctx (builder stage) [src] [objpath]
-
-compileObject
- :: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action ()
-compileObject rs objpath b@(BuildPath _root _stage _path (Hs o)) =
- compileHsObject rs objpath b o
-compileObject rs objpath b@(BuildPath _root _stage _path (NonHs o)) =
- compileNonHsObject rs objpath b o
+compileHsObjectAndHi
+ :: [(Resource, Int)] -> FilePath -> Action ()
+compileHsObjectAndHi rs objpath = do
+ root <- buildRoot
+ b@(BuildPath _root stage _path _o)
+ <- parsePath (parseBuildObject root) "<object file path parser>" objpath
+ let ctx = objectContext b
+ way = C.way ctx
+ ctxPath <- contextPath ctx
+ (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath
+ need (src:deps)
+ needLibrary =<< contextDependencies ctx
+
+ -- The .dependencies file lists indicating inputs. ghc will
+ -- generally read more *.hi and *.hi-boot files (direct inputs).
+ -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#haskell-object-files-and-hi-inputs)
+ -- Note that this may allow too many *.hi and *.hi-boot files, but
+ -- calculating the exact set of direct inputs is not feasible.
+ trackAllow [ "//*." ++ hisuf way
+ , "//*." ++ hibootsuf way
+ ]
+
+ buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath]
+
+compileNonHsObject :: [(Resource, Int)] -> SourceLang -> FilePath -> Action ()
+compileNonHsObject rs lang path = do
+ root <- buildRoot
+ b@(BuildPath _root stage _path _o)
+ <- parsePath (parseBuildObject root) "<object file path parser>" path
+ let
+ ctx = objectContext b
+ builder = case lang of
+ C -> Ghc CompileCWithGhc
+ _ -> Ghc CompileHs
+ src <- case lang of
+ Asm -> obj2src "S" (const False) ctx path
+ C -> obj2src "c" (const False) ctx path
+ Cmm -> obj2src "cmm" isGeneratedCmmFile ctx path
+ need [src]
+ needDependencies ctx src (path <.> "d")
+ buildWithResources rs $ target ctx (builder stage) [src] [path]
-- * Helpers
=====================================
libraries/base/GHC/Event/Poll.hsc
=====================================
@@ -162,24 +162,12 @@ newtype Event = Event CShort
, FiniteBits -- ^ @since 4.7.0.0
)
--- We have to duplicate the whole enum like this in order for the
--- hsc2hs cross-compilation mode to work
-#if defined(POLLRDHUP)
#{enum Event, Event
, pollIn = POLLIN
, pollOut = POLLOUT
- , pollRdHup = POLLRDHUP
, pollErr = POLLERR
, pollHup = POLLHUP
}
-#else
-#{enum Event, Event
- , pollIn = POLLIN
- , pollOut = POLLOUT
- , pollErr = POLLERR
- , pollHup = POLLHUP
- }
-#endif
fromEvent :: E.Event -> Event
fromEvent e = remap E.evtRead pollIn .|.
=====================================
libraries/ghc-heap/tests/ClosureSizeUtils.hs
=====================================
@@ -0,0 +1,52 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Utilities for the @closure_size@ tests
+module ClosureSizeUtils (assertSize, assertSizeUnlifted) where
+
+import Control.Monad
+import GHC.Exts
+import GHC.Exts.Heap.Closures
+import GHC.Stack
+import Type.Reflection
+
+profHeaderSize :: Int
+#if PROFILING
+profHeaderSize = 2
+#else
+profHeaderSize = 0
+#endif
+
+assertSize
+ :: forall a. (HasCallStack, Typeable a)
+ => a -- ^ closure
+ -> Int -- ^ expected size in words
+ -> IO ()
+assertSize x =
+ assertSizeBox (asBox x) (typeRep @a)
+
+assertSizeUnlifted
+ :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a)
+ => a -- ^ closure
+ -> Int -- ^ expected size in words
+ -> IO ()
+assertSizeUnlifted x =
+ assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a)
+
+assertSizeBox
+ :: forall a. (HasCallStack)
+ => Box -- ^ closure
+ -> TypeRep a
+ -> Int -- ^ expected size in words
+ -> IO ()
+assertSizeBox x ty expected = do
+ let !size = closureSize x
+ when (size /= expected') $ do
+ putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected'
+ putStrLn $ prettyCallStack callStack
+ where expected' = expected + profHeaderSize
+{-# NOINLINE assertSize #-}
=====================================
libraries/ghc-heap/tests/all.T
=====================================
@@ -1,11 +1,26 @@
test('heap_all',
- [when(have_profiling(),
- extra_ways(['prof'])),
+ [when(have_profiling(), extra_ways(['prof'])),
# These ways produce slightly different heap representations.
# Currently we don't test them.
omit_ways(['ghci', 'hpc'])
],
compile_and_run, [''])
+
+# Test everything except FUNs and PAPs in all ways.
test('closure_size',
- omit_ways(['ghci', 'hpc', 'prof']),
+ [extra_files(['ClosureSizeUtils.hs']),
+ when(have_profiling(), extra_ways(['prof'])),
+ # These ways produce slightly different heap representations.
+ # Currently we don't test them.
+ omit_ways(['hpc'])
+ ],
+ compile_and_run, [''])
+
+# Test PAPs and FUNs only in normal way (e.g. with -O0)
+# since otherwise the simplifier interferes.
+test('closure_size_noopt',
+ [extra_files(['ClosureSizeUtils.hs']),
+ only_ways(['normal'])
+ ],
compile_and_run, [''])
+
=====================================
libraries/ghc-heap/tests/closure_size.hs
=====================================
@@ -1,25 +1,20 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ScopedTypeVariables #-}
-import Control.Monad
-import Type.Reflection
-import GHC.Stack
+import GHC.Exts
+import GHC.IO
+import ClosureSizeUtils
-import GHC.Exts.Heap.Closures
+data A = A (Array# Int)
+data MA = MA (MutableArray# RealWorld Int)
+data BA = BA ByteArray#
+data MBA = MBA (MutableByteArray# RealWorld)
+data B = B BCO#
+data APC a = APC a
-assertSize :: forall a. (HasCallStack, Typeable a)
- => a -> Int -> IO ()
-assertSize !x expected = do
- let !size = closureSize (asBox x)
- when (size /= expected) $ do
- putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected
- putStrLn $ prettyCallStack callStack
-{-# NOINLINE assertSize #-}
-
-pap :: Int -> Char -> Int
-pap x _ = x
-{-# NOINLINE pap #-}
main :: IO ()
main = do
@@ -28,7 +23,26 @@ main = do
assertSize (Nothing :: Maybe ()) 2
assertSize ((1,2) :: (Int,Int)) 3
assertSize ((1,2,3) :: (Int,Int,Int)) 4
- assertSize (id :: Int -> Int) 1
- assertSize (fst :: (Int,Int) -> Int) 1
- assertSize (pap 1) 2
+ MA ma <- IO $ \s ->
+ case newArray# 0# 0 s of
+ (# s1, x #) -> (# s1, MA x #)
+
+ A a <- IO $ \s ->
+ case freezeArray# ma 0# 0# s of
+ (# s1, x #) -> (# s1, A x #)
+
+ MBA mba <- IO $ \s ->
+ case newByteArray# 0# s of
+ (# s1, x #) -> (# s1, MBA x #)
+
+ BA ba <- IO $ \s ->
+ case newByteArray# 0# s of
+ (# s1, x #) ->
+ case unsafeFreezeByteArray# x s1 of
+ (# s2, y #) -> (# s2, BA y #)
+
+ assertSizeUnlifted ma 3
+ assertSizeUnlifted a 3
+ assertSizeUnlifted mba 2
+ assertSizeUnlifted ba 2
=====================================
libraries/ghc-heap/tests/closure_size_noopt.hs
=====================================
@@ -0,0 +1,12 @@
+import ClosureSizeUtils
+
+pap :: Int -> Char -> Int
+pap x _ = x
+{-# NOINLINE pap #-}
+
+main :: IO ()
+main = do
+ assertSize (id :: Int -> Int) 1
+ assertSize (fst :: (Int,Int) -> Int) 1
+ assertSize (pap 1) 2
+
=====================================
testsuite/tests/concurrent/should_run/conc059.stdout
=====================================
@@ -1,3 +1,3 @@
-500000
exiting...
+500000
exited.
=====================================
testsuite/tests/concurrent/should_run/conc059_c.c
=====================================
@@ -16,6 +16,7 @@ int main(int argc, char *argv[])
usleep(100000);
#endif
printf("exiting...\n");
+ fflush(stdout);
hs_exit();
printf("exited.\n");
#if mingw32_HOST_OS
=====================================
testsuite/tests/driver/T8602/T8602.script
=====================================
@@ -1,3 +1,4 @@
-:! echo 'echo $4 $5 $6; exit 1' > t8602.sh
+:! echo '#!/bin/sh' > t8602.sh
+:! echo 'echo $4 $5 $6; exit 1' >> t8602.sh
:! chmod +x t8602.sh
:load A
=====================================
testsuite/tests/ffi/should_run/ffi005.hs
=====================================
@@ -21,6 +21,7 @@ main = do
putStrLn "\nTesting puts (and withString)"
withCString "Test successful" puts
+ c_fflush c_stdout
putStrLn "\nTesting peekArray0"
s <- withCString "Test successful" (peekArray0 (castCharToCChar '\0'))
@@ -71,6 +72,8 @@ withBuffer sz m = do
return s
foreign import ccall puts :: CString -> IO CInt
+foreign import ccall "fflush" c_fflush :: Ptr () -> IO CInt
+foreign import ccall "stdio.h stdout" c_stdout :: Ptr ()
-- foreign import ccall "open" open' :: CString -> CInt -> IO CInt
-- foreign import ccall "open" open2' :: CString -> CInt -> CInt -> IO CInt
=====================================
testsuite/tests/rts/T5423.stdout
=====================================
@@ -1,2 +1,2 @@
-120
111 112 113 114 115 116 117 118 119 120
+120
=====================================
testsuite/tests/rts/T5423_cmm.cmm
=====================================
@@ -12,5 +12,6 @@ test (W_ r1,
{
foreign "C" printf("%d %d %d %d %d %d %d %d %d %d\n",
r1, r2, r3, r4, r5, r6, r7, r8, r9, r10);
+ foreign "C" fflush(W_[stdout]);
return (r10);
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/81dd0eaa2b50baf859cc42f8f251e3f8ee30d8a6...915a704255539d70e975af4bf46523ef5e6479c6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/81dd0eaa2b50baf859cc42f8f251e3f8ee30d8a6...915a704255539d70e975af4bf46523ef5e6479c6
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/20190611/e9ffc953/attachment-0001.html>
More information about the ghc-commits
mailing list