[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Improve ThreadId Show instance
Marge Bot
gitlab at gitlab.haskell.org
Sat Jun 1 09:58:54 UTC 2019
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
1d43d4a3 by Nathan Collins at 2019-06-01T03:55:49Z
Improve ThreadId Show instance
By making it include parens when a derived instance would. For example, this changes the (hypothetical) code `show (Just (ThreadId 3))` to produce `"Just (ThreadId 3)"` instead of the current `"Just ThreadId 3"`.
- - - - -
45f88494 by Ryan Scott at 2019-06-01T03:56:27Z
Reject nested foralls in foreign imports (#16702)
This replaces a panic observed in #16702 with a simple error message
stating that nested `forall`s simply aren't allowed in the type
signature of a `foreign import` (at least, not at present).
Fixes #16702.
- - - - -
76e58890 by Ryan Scott at 2019-06-01T03:57:05Z
Fix space leaks in dynLoadObjs (#16708)
When running the test suite on a GHC built with the `quick` build
flavour, `-fghci-leak-check` noticed some space leaks. Careful
investigation led to `Linker.dynLoadObjs` being the culprit.
Pattern-matching on `PeristentLinkerState` and a dash of `$!` were
sufficient to fix the issue. (ht to mpickering for his suggestions,
which were crucial to discovering a fix)
Fixes #16708.
- - - - -
d9d0e514 by Ömer Sinan Ağacan at 2019-06-01T09:58:48Z
Fix rewriting invalid shifts to errors
Fixes #16449.
5341edf3 removed a code in rewrite rules for bit shifts, which broke the
"silly shift guard", causing generating invalid bit shifts or heap
overflow in compile time while trying to evaluate those invalid bit
shifts.
The "guard" is explained in Note [Guarding against silly shifts] in
PrelRules.hs.
More specifically, this was the breaking change:
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -474,12 +474,11 @@ shiftRule shift_op
; case e1 of
_ | shift_len == 0
-> return e1
- | shift_len < 0 || wordSizeInBits dflags < shift_len
- -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy
- ("Bad shift length" ++ show shift_len))
This patch reverts this change.
Two new tests added:
- T16449_1: The original reproducer in #16449. This was previously
casing a heap overflow in compile time when CmmOpt tries to evaluate
the large (invalid) bit shift in compile time, using `Integer` as the
result type. Now it builds as expected. We now generate an error for
the shift as expected.
- T16449_2: Tests code generator for large (invalid) bit shifts.
- - - - -
26736f3c by Ömer Sinan Ağacan at 2019-06-01T09:58:50Z
rts: Remove unused decls from CNF.h
- - - - -
14 changed files:
- compiler/ghci/Linker.hs
- compiler/prelude/PrelRules.hs
- compiler/typecheck/TcForeign.hs
- docs/users_guide/ffi-chap.rst
- libraries/base/GHC/Conc/Sync.hs
- rts/sm/CNF.h
- + testsuite/tests/codeGen/should_compile/T16449_1.hs
- testsuite/tests/codeGen/should_compile/all.T
- + testsuite/tests/codeGen/should_run/T16449_2.hs
- + testsuite/tests/codeGen/should_run/T16449_2.stderr
- testsuite/tests/codeGen/should_run/all.T
- + testsuite/tests/ffi/should_fail/T16702.hs
- + testsuite/tests/ffi/should_fail/T16702.stderr
- testsuite/tests/ffi/should_fail/all.T
Changes:
=====================================
compiler/ghci/Linker.hs
=====================================
@@ -115,7 +115,7 @@ readPLS dl =
modifyMbPLS_
:: DynLinker -> (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO ()
-modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f
+modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f
emptyPLS :: DynFlags -> PersistentLinkerState
emptyPLS _ = PersistentLinkerState {
@@ -881,8 +881,8 @@ dynLinkObjs hsc_env pls objs = do
dynLoadObjs :: HscEnv -> PersistentLinkerState -> [FilePath]
-> IO PersistentLinkerState
-dynLoadObjs _ pls [] = return pls
-dynLoadObjs hsc_env pls objs = do
+dynLoadObjs _ pls [] = return pls
+dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do
let dflags = hsc_dflags hsc_env
let platform = targetPlatform dflags
let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ]
@@ -899,13 +899,13 @@ dynLoadObjs hsc_env pls objs = do
-- library.
ldInputs =
concatMap (\l -> [ Option ("-l" ++ l) ])
- (nub $ snd <$> temp_sos pls)
+ (nub $ snd <$> temp_sos)
++ concatMap (\lp -> [ Option ("-L" ++ lp)
, Option "-Xlinker"
, Option "-rpath"
, Option "-Xlinker"
, Option lp ])
- (nub $ fst <$> temp_sos pls)
+ (nub $ fst <$> temp_sos)
++ concatMap
(\lp ->
[ Option ("-L" ++ lp)
@@ -933,13 +933,13 @@ dynLoadObjs hsc_env pls objs = do
-- link all "loaded packages" so symbols in those can be resolved
-- Note: We are loading packages with local scope, so to see the
-- symbols in this link we must link all loaded packages again.
- linkDynLib dflags2 objs (pkgs_loaded pls)
+ linkDynLib dflags2 objs pkgs_loaded
-- if we got this far, extend the lifetime of the library file
changeTempFilesLifetime dflags TFL_GhcSession [soFile]
m <- loadDLL hsc_env soFile
case m of
- Nothing -> return pls { temp_sos = (libPath, libName) : temp_sos pls }
+ Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos }
Just err -> panic ("Loading temp shared object failed: " ++ err)
rmDupLinkables :: [Linkable] -- Already loaded
=====================================
compiler/prelude/PrelRules.hs
=====================================
@@ -467,13 +467,16 @@ shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> RuleM CoreExpr
-- Used for shift primops
-- ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word#
-- SllOp, SrlOp :: Word# -> Int# -> Word#
--- See Note [Guarding against silly shifts]
shiftRule shift_op
= do { dflags <- getDynFlags
; [e1, Lit (LitNumber LitNumInt shift_len _)] <- getArgs
; case e1 of
_ | shift_len == 0
-> return e1
+ -- See Note [Guarding against silly shifts]
+ | shift_len < 0 || shift_len > wordSizeInBits dflags
+ -> return $ mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy
+ ("Bad shift length " ++ show shift_len)
-- Do the shift at type Integer, but shift length is Int
Lit (LitNumber nt x t)
=====================================
compiler/typecheck/TcForeign.hs
=====================================
@@ -64,7 +64,6 @@ import Hooks
import qualified GHC.LanguageExtensions as LangExt
import Control.Monad
-import Data.Maybe
-- Defines a binding
isForeignImport :: LForeignDecl name -> Bool
@@ -251,8 +250,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty
; let
-- Drop the foralls before inspecting the
-- structure of the foreign type.
- (bndrs, res_ty) = tcSplitPiTys norm_sig_ty
- arg_tys = mapMaybe binderRelevantType_maybe bndrs
+ (arg_tys, res_ty) = tcSplitFunTys (dropForAlls norm_sig_ty)
id = mkLocalId nm sig_ty
-- Use a LocalId to obey the invariant that locally-defined
-- things are LocalIds. However, it does not need zonking,
@@ -424,10 +422,9 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do
checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty
return (CExport (L l (CExportStatic esrc str cconv')) src)
where
- -- Drop the foralls before inspecting n
+ -- Drop the foralls before inspecting
-- the structure of the foreign type.
- (bndrs, res_ty) = tcSplitPiTys sig_ty
- arg_tys = mapMaybe binderRelevantType_maybe bndrs
+ (arg_tys, res_ty) = tcSplitFunTys (dropForAlls sig_ty)
{-
************************************************************************
@@ -458,6 +455,11 @@ checkForeignRes non_io_result_ok check_safe pred_res_ty ty
= -- Got an IO result type, that's always fine!
check (pred_res_ty res_ty) (illegalForeignTyErr result)
+ -- We disallow nested foralls in foreign types
+ -- (at least, for the time being). See #16702.
+ | tcIsForAllTy ty
+ = addErrTc $ illegalForeignTyErr result (text "Unexpected nested forall")
+
-- Case for non-IO result type with FFI Import
| not non_io_result_ok
= addErrTc $ illegalForeignTyErr result (text "IO result type expected")
=====================================
docs/users_guide/ffi-chap.rst
=====================================
@@ -14,9 +14,10 @@ Foreign function interface (FFI)
Allow use of the Haskell foreign function interface.
-GHC (mostly) conforms to the Haskell Foreign Function Interface, whose
-definition is part of the Haskell Report on
-`http://www.haskell.org/ <http://www.haskell.org/>`__.
+GHC (mostly) conforms to the Haskell Foreign Function Interface as specified
+in the Haskell Report. Refer to the `relevant chapter
+<https://www.haskell.org/onlinereport/haskell2010/haskellch8.html>_`
+of the Haskell Report for more details.
FFI support is enabled by default, but can be enabled or disabled
explicitly with the :extension:`ForeignFunctionInterface` flag.
@@ -102,6 +103,25 @@ OK: ::
foreign import foo :: Int -> MyIO Int
foreign import "dynamic" baz :: (Int -> MyIO Int) -> CInt -> MyIO Int
+.. _ffi-foralls:
+
+Explicit ``forall``s in foreign types
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The type variables in the type of a foreign declaration may be quantified with
+an explicit ``forall`` by using the :extension:`ExplicitForAll` language
+extension, as in the following example: ::
+
+ {-# LANGUAGE ExplicitForAll #-}
+ foreign import ccall "mmap" c_mmap :: forall a. CSize -> IO (Ptr a)
+
+Note that an explicit ``forall`` must appear at the front of the type signature
+and is not permitted to appear nested within the type, as in the following
+(erroneous) examples: ::
+
+ foreign import ccall "mmap" c_mmap' :: CSize -> forall a. IO (Ptr a)
+ foreign import ccall quux :: (forall a. Ptr a) -> IO ()
+
.. _ffi-prim:
Primitive imports
=====================================
libraries/base/GHC/Conc/Sync.hs
=====================================
@@ -113,7 +113,7 @@ import GHC.IORef
import GHC.MVar
import GHC.Ptr
import GHC.Real ( fromIntegral )
-import GHC.Show ( Show(..), showString )
+import GHC.Show ( Show(..), showParen, showString )
import GHC.Stable ( StablePtr(..) )
import GHC.Weak
@@ -145,7 +145,7 @@ This misfeature will hopefully be corrected at a later date.
-- | @since 4.2.0.0
instance Show ThreadId where
- showsPrec d t =
+ showsPrec d t = showParen (d >= 11) $
showString "ThreadId " .
showsPrec d (getThreadId (id2TSO t))
=====================================
rts/sm/CNF.h
=====================================
@@ -15,9 +15,6 @@
#include "BeginPrivate.h"
-void initCompact (void);
-void exitCompact (void);
-
StgCompactNFData *compactNew (Capability *cap,
StgWord size);
void compactResize(Capability *cap,
=====================================
testsuite/tests/codeGen/should_compile/T16449_1.hs
=====================================
@@ -0,0 +1,8 @@
+module T16449_1 where
+
+import Data.Bits (setBit)
+
+f :: Int
+f = foldl setter 0 $ zip [0..] [()]
+ where
+ setter v (ix, _) = setBit v ix
=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -59,3 +59,5 @@ test('T15155',
test('T15155l', when(unregisterised(), skip),
makefile_test, [])
+
+test('T16449_1', normal, compile, [''])
=====================================
testsuite/tests/codeGen/should_run/T16449_2.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE MagicHash #-}
+
+module Main where
+
+import GHC.Prim
+import GHC.Int
+
+-- Shift should be larger than the word size (e.g. 64 on 64-bit) for this test.
+main = print (I# (uncheckedIShiftL# 1# 1000#))
=====================================
testsuite/tests/codeGen/should_run/T16449_2.stderr
=====================================
@@ -0,0 +1 @@
+T16449_2: Bad shift length 1000
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -195,3 +195,4 @@ test('T15892',
extra_run_opts('+RTS -G1 -A32k -RTS') ],
compile_and_run, ['-O'])
test('T16617', normal, compile_and_run, [''])
+test('T16449_2', exit_code(1), compile_and_run, [''])
=====================================
testsuite/tests/ffi/should_fail/T16702.hs
=====================================
@@ -0,0 +1,24 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE RankNTypes #-}
+
+module T16702 where
+
+import Foreign.C.Types
+import Foreign.Ptr
+import Data.Kind (Type)
+
+foreign import ccall "math.h pow"
+ c_pow :: CDouble
+ -> forall (a :: Type). CDouble
+ -> forall (b :: Type). CDouble
+
+foreign import ccall "malloc"
+ malloc1 :: CSize -> forall a. IO (Ptr a)
+
+foreign import ccall "malloc"
+ malloc2 :: Show a => CSize -> IO (Ptr a)
+
+foreign import ccall "malloc"
+ malloc3 :: CSize -> Show a => IO (Ptr a)
=====================================
testsuite/tests/ffi/should_fail/T16702.stderr
=====================================
@@ -0,0 +1,29 @@
+
+T16702.hs:12:1: error:
+ • Unacceptable result type in foreign declaration:
+ Unexpected nested forall
+ • When checking declaration:
+ foreign import ccall safe "math.h pow" c_pow
+ :: CDouble
+ -> forall (a :: Type). CDouble -> forall (b :: Type). CDouble
+
+T16702.hs:17:1: error:
+ • Unacceptable result type in foreign declaration:
+ Unexpected nested forall
+ • When checking declaration:
+ foreign import ccall safe "malloc" malloc1
+ :: CSize -> forall a. IO (Ptr a)
+
+T16702.hs:20:1: error:
+ • Unacceptable argument type in foreign declaration:
+ ‘Show a’ cannot be marshalled in a foreign call
+ • When checking declaration:
+ foreign import ccall safe "malloc" malloc2
+ :: Show a => CSize -> IO (Ptr a)
+
+T16702.hs:23:1: error:
+ • Unacceptable argument type in foreign declaration:
+ ‘Show a’ cannot be marshalled in a foreign call
+ • When checking declaration:
+ foreign import ccall safe "malloc" malloc3
+ :: CSize -> Show a => IO (Ptr a)
=====================================
testsuite/tests/ffi/should_fail/all.T
=====================================
@@ -14,6 +14,7 @@ test('T5664', normal, compile_fail, ['-v0'])
test('T7506', normal, compile_fail, [''])
test('T7243', normal, compile_fail, [''])
test('T10461', normal, compile_fail, [''])
+test('T16702', normal, compile_fail, [''])
# UnsafeReenter tests implementation of an undefined behavior (calling Haskell
# from an unsafe foreign function) and only makes sense in non-threaded way
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3c8d1989a19faa65287c976fecfdbde96995d367...26736f3c71df568f5fb71e2fb25d2534efb94759
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/3c8d1989a19faa65287c976fecfdbde96995d367...26736f3c71df568f5fb71e2fb25d2534efb94759
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/20190601/e2be33fa/attachment-0001.html>
More information about the ghc-commits
mailing list