[Git][ghc/ghc][wip/happy-coerce] 6 commits: Add Generic tuple instances up to 15-tuple

Vladislav Zavialov gitlab at gitlab.haskell.org
Sat May 11 19:42:24 UTC 2019



Vladislav Zavialov pushed to branch wip/happy-coerce at Glasgow Haskell Compiler / GHC


Commits:
5eb94454 by Oleg Grenrus at 2019-05-10T20:26:28Z
Add Generic tuple instances up to 15-tuple

Why 15? Because we have Eq instances up to 15.

Metric Increase:
    T9630
    haddock.base

- - - - -
c7913f71 by Roland Senn at 2019-05-10T20:32:38Z
Fix bugs and documentation for #13456

- - - - -
bfcd986d by David Eichmann at 2019-05-10T20:38:57Z
Hadrian: programs need registered ghc-pkg libraries

In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e.

    _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so

Add the corresponding `need`s for these library files and the subsequent rules.

- - - - -
10f579ad by Ben Gamari at 2019-05-10T20:45:05Z
gitlab-ci: Disable cleanup job on Windows

As discussed in the Note, we now have a cron job to handle this and the
cleanup job itself is quite fragile.

[skip ci]

- - - - -
6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z
Add regression test case for old issue #493

- - - - -
b6f8bc7b by Vladislav Zavialov at 2019-05-11T19:42:06Z
Restore the --coerce option in 'happy' configuration

happy-1.19.10 has been released with a fix for --coerce in the presence
of higher rank types. This should result in about 10% performance
improvement in the parser.

- - - - -


23 changed files:

- .gitlab-ci.yml
- aclocal.m4
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- hadrian/hadrian.cabal
- hadrian/src/Context.hs
- hadrian/src/Hadrian/BuildPath.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Program.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Settings/Builders/Happy.hs
- libraries/base/GHC/Generics.hs
- mk/config.mk.in
- testsuite/.gitignore
- + testsuite/tests/ffi/should_run/T493.hs
- + testsuite/tests/ffi/should_run/T493.stdout
- + testsuite/tests/ffi/should_run/T493_c.c
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/ghci/scripts/T8113.script
- testsuite/tests/ghci/scripts/ghci005.stdout
- + testsuite/tests/ghci/should_run/T13456.script
- + testsuite/tests/ghci/should_run/T13456.stdout
- testsuite/tests/ghci/should_run/all.T


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: cefaee3c742af193e0f7783f87edb0d35374515c
+  DOCKER_REV: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f
 
   # Sequential version number capturing the versions of all tools fetched by
   # .gitlab/win32-init.sh.
@@ -19,7 +19,7 @@ stages:
   - lint       # Source linting
   - build      # A quick smoke-test to weed out broken commits
   - full-build # Build all the things
-  - cleanup    # See Note [Cleanup on Windows]
+  - cleanup    # See Note [Cleanup after the shell executor]
   - packaging  # Source distribution, etc.
   - hackage    # head.hackage testing
   - deploy     # push documentation
@@ -176,7 +176,7 @@ validate-x86_64-linux-deb8-hadrian:
 hadrian-ghc-in-ghci:
   <<: *only-default
   stage: build
-  image: ghcci/x86_64-linux-deb8:0.1
+  image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb8:$DOCKER_REV"
   before_script:
     # workaround for docker permissions
     - sudo chown ghc:ghc -R .
@@ -673,35 +673,18 @@ nightly-i386-windows:
 #
 # As noted in [1], gitlab-runner's shell executor doesn't clean up its working
 # directory after builds. Unfortunately, we are forced to use the shell executor
-# on Windows. To avoid running out of disk space we add a stage at the end of
-# the build to remove the \GitLabRunner\builds directory. Since we only run a
-# single build at a time on Windows this should be safe.
+# on Darwin. To avoid running out of disk space we add a stage at the end of
+# the build to remove the /.../GitLabRunner/builds directory. Since we only run a
+# single build at a time on Darwin this should be safe.
+#
+# We used to have a similar cleanup job on Windows as well however it ended up
+# being quite fragile as we have multiple Windows builders yet there is no
+# guarantee that the cleanup job is run on the same machine as the build itself
+# was run. Consequently we were forced to instead handle cleanup with a separate
+# cleanup cron job on Windows.
 #
 # [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856
 
-# See Note [Cleanup after shell executor]
-cleanup-windows:
-  <<: *only-default
-  stage: cleanup
-  tags:
-    - x86_64-windows
-  when: always
-  dependencies: []
-  before_script:
-    - echo "Time to clean up"
-  script:
-    - echo "Let's go"
-  after_script:
-    - set "BUILD_DIR=%CI_PROJECT_DIR%"
-    - set "BUILD_DIR=%BUILD_DIR:/=\%"
-    - echo "Cleaning %BUILD_DIR%"
-    - cd \GitLabRunner
-    # This is way more complicated than it should be:
-    # See https://stackoverflow.com/questions/1965787
-    - del %BUILD_DIR%\* /F /Q
-    - for /d %%p in (%BUILD_DIR%\*) do rd /Q /S "%%p"
-    - exit /b 0
-
 # See Note [Cleanup after shell executor]
 cleanup-darwin:
   <<: *only-default


=====================================
aclocal.m4
=====================================
@@ -951,8 +951,8 @@ changequote([, ])dnl
 ])
 if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs
 then
-    FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.4],
-      [AC_MSG_ERROR([Happy version 1.19.4 or later is required to compile GHC.])])[]
+    FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.10],
+      [AC_MSG_ERROR([Happy version 1.19.10 or later is required to compile GHC.])])[]
 fi
 HappyVersion=$fptools_cv_happy_version;
 AC_SUBST(HappyVersion)


=====================================
docs/users_guide/ghci.rst
=====================================
@@ -2366,7 +2366,10 @@ commonly used commands.
     Typing ``:def`` on its own lists the currently-defined macros.
     Attempting to redefine an existing command name results in an error
     unless the ``:def!`` form is used, in which case the old command
-    with that name is silently overwritten.
+    with that name is silently overwritten. However for builtin commands
+    the old command can still be used by preceeding the command name with
+    a double colon (eg ``::load``).
+    It's not possible to redefine the commands ``:{``, ``:}`` and ``:!``.
 
 .. ghci-cmd:: :delete; * | ⟨num⟩ ...
 


=====================================
ghc/GHCi/UI.hs
=====================================
@@ -1618,8 +1618,11 @@ chooseEditFile =
 -- :def
 
 defineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m ()
-defineMacro _ (':':_) =
-  liftIO $ putStrLn "macro name cannot start with a colon"
+defineMacro _ (':':_) = liftIO $ putStrLn
+                          "macro name cannot start with a colon"
+defineMacro _ ('!':_) = liftIO $ putStrLn
+                          "macro name cannot start with an exclamation mark"
+                          -- little code duplication allows to grep error msg
 defineMacro overwrite s = do
   let (macro_name, definition) = break isSpace s
   macros <- ghci_macros <$> getGHCiState
@@ -1629,33 +1632,38 @@ defineMacro overwrite s = do
                 then liftIO $ putStrLn "no macros defined"
                 else liftIO $ putStr ("the following macros are defined:\n" ++
                                       unlines defined)
-        else do
-  if (not overwrite && macro_name `elem` defined)
-        then throwGhcException (CmdLineError
-                ("macro '" ++ macro_name ++ "' is already defined"))
-        else do
-
-  -- compile the expression
-  handleSourceError GHC.printException $ do
-    step <- getGhciStepIO
-    expr <- GHC.parseExpr definition
-    -- > ghciStepIO . definition :: String -> IO String
-    let stringTy = nlHsTyVar stringTy_RDR
-        ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
-        body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
-                                   `mkHsApp` (nlHsPar expr)
-        tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM)
-        new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig
-    hv <- GHC.compileParsedExprRemote new_expr
-
-    let newCmd = Command { cmdName = macro_name
-                         , cmdAction = lift . runMacro hv
-                         , cmdHidden = False
-                         , cmdCompletionFunc = noCompletion
-                         }
-
-    -- later defined macros have precedence
-    modifyGHCiState $ \s ->
+  else do
+    isCommand <- isJust <$> lookupCommand' macro_name
+    let check_newname
+          | macro_name `elem` defined = throwGhcException (CmdLineError
+            ("macro '" ++ macro_name ++ "' is already defined. " ++ hint))
+          | isCommand = throwGhcException (CmdLineError
+            ("macro '" ++ macro_name ++ "' overwrites builtin command. " ++ hint))
+          | otherwise = return ()
+        hint = " Use ':def!' to overwrite."
+
+    unless overwrite check_newname
+    -- compile the expression
+    handleSourceError GHC.printException $ do
+      step <- getGhciStepIO
+      expr <- GHC.parseExpr definition
+      -- > ghciStepIO . definition :: String -> IO String
+      let stringTy = nlHsTyVar stringTy_RDR
+          ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
+          body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
+                                     `mkHsApp` (nlHsPar expr)
+          tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM)
+          new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig
+      hv <- GHC.compileParsedExprRemote new_expr
+
+      let newCmd = Command { cmdName = macro_name
+                           , cmdAction = lift . runMacro hv
+                           , cmdHidden = False
+                           , cmdCompletionFunc = noCompletion
+                           }
+
+      -- later defined macros have precedence
+      modifyGHCiState $ \s ->
         let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]
         in s { ghci_macros = newCmd : filtered }
 


=====================================
hadrian/hadrian.cabal
=====================================
@@ -132,7 +132,7 @@ executable hadrian
                        , transformers         >= 0.4     && < 0.6
                        , unordered-containers >= 0.2.1   && < 0.3
     build-tools:         alex  >= 3.1
-                       , happy >= 1.19.4
+                       , happy >= 1.19.10
     ghc-options:       -Wall
                        -Wincomplete-record-updates
                        -Wredundant-constraints


=====================================
hadrian/src/Context.hs
=====================================
@@ -7,8 +7,8 @@ module Context (
 
     -- * Paths
     contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile,
-    pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath,
-    contextPath, getContextPath, libPath, distDir
+    pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile,
+    pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir
     ) where
 
 import Base
@@ -59,11 +59,16 @@ distDir st = do
     hostArch       <- cabalArchString <$> setting BuildArch
     return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version
 
+pkgFileName :: Package -> String -> String -> Action FilePath
+pkgFileName package prefix suffix = do
+    pid  <- pkgIdentifier package
+    return $ prefix ++ pid ++ suffix
+
 pkgFile :: Context -> String -> String -> Action FilePath
 pkgFile context at Context {..} prefix suffix = do
     path <- buildPath context
-    pid  <- pkgIdentifier package
-    return $ path -/- prefix ++ pid ++ suffix
+    fileName <- pkgFileName package prefix suffix
+    return $ path -/- fileName
 
 -- | Path to inplace package configuration file of a given 'Context'.
 pkgInplaceConfig :: Context -> Action FilePath
@@ -81,6 +86,20 @@ pkgHaddockFile Context {..} = do
     let name = pkgName package
     return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock"
 
+-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.:
+-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@
+-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@
+pkgRegisteredLibraryFile :: Context -> Action FilePath
+pkgRegisteredLibraryFile context at Context {..} = do
+    libDir    <- libPath context
+    pkgId     <- pkgIdentifier package
+    extension <- libsuf stage way
+    fileName  <- pkgFileName package "libHS" extension
+    distDir   <- distDir stage
+    return $ if Dynamic `wayUnit` way
+        then libDir -/- distDir -/- fileName
+        else libDir -/- distDir -/- pkgId -/- fileName
+
 -- | Path to the library file of a given 'Context', e.g.:
 -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a at .
 pkgLibraryFile :: Context -> Action FilePath


=====================================
hadrian/src/Hadrian/BuildPath.hs
=====================================
@@ -35,6 +35,40 @@ parseBuildPath root afterBuild = do
     a <- afterBuild
     return (BuildPath root stage pkgpath a)
 
+-- | A path of the form
+--
+-- > <build root>/stage<N>/lib/<arch>-<os>-ghc-<ghc version>/<something>
+--
+-- where @something@ describes a library or object file or ... to be registerd
+-- for the given package. These are files registered into a ghc-pkg database.
+--
+-- @a@, which represents that @something@, is instantiated with library-related
+-- data types in @Rules.Library@ and with object/interface files related types
+-- in @Rules.Compile at .
+data GhcPkgPath a
+    = GhcPkgPath
+        FilePath -- ^ > <build root>/
+        Stage    -- ^ > stage<N>/
+        FilePath -- ^ > lib/<arch>-<os>-ghc-<ghc version>/
+        a        -- ^ > whatever comes after
+        deriving (Eq, Show)
+
+-- | Parse a registered ghc-pkg path under the given build root.
+parseGhcPkgPath
+    :: FilePath -- ^ build root
+    -> Parsec.Parsec String () a -- ^ what to parse after @build/@
+    -> Parsec.Parsec String () (GhcPkgPath a)
+parseGhcPkgPath root after = do
+    _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
+    stage <- parseStage
+    _ <- Parsec.char '/'
+    regPath <- Parsec.string "lib/"
+            <> Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/")
+    a <- after
+    return (GhcPkgPath root stage regPath a)
+
+
+
 -- To be kept in sync with Stage.hs's stageString function
 -- | Parse @"stageX"@ into a 'Stage'.
 parseStage :: Parsec.Parsec String () Stage


=====================================
hadrian/src/Rules/Library.hs
=====================================
@@ -24,11 +24,27 @@ libraryRules = do
     root -/- "//libHS*-*.so"          %> buildDynamicLibUnix root "so"
     root -/- "//*.a"                  %> buildStaticLib      root
     priority 2 $ do
-        root -/- "//HS*-*.o" %> buildGhciLibO root
+        root -/- "stage*/lib//libHS*-*.dylib" %> registerDynamicLibUnix root "dylib"
+        root -/- "stage*/lib//libHS*-*.so"    %> registerDynamicLibUnix root "so"
+        root -/- "stage*/lib//*.a"            %> registerStaticLib  root
+        root -/- "//HS*-*.o"   %> buildGhciLibO root
         root -/- "//HS*-*.p_o" %> buildGhciLibO root
 
 -- * 'Action's for building libraries
 
+-- | Register (with ghc-pkg) a static library ('LibA') under the given build
+-- root, whose path is the second argument.
+registerStaticLib :: FilePath -> FilePath -> Action ()
+registerStaticLib root archivePath = do
+    -- Simply need the ghc-pkg database .conf file.
+    GhcPkgPath _ stage _ (LibA name version _)
+        <- parsePath (parseGhcPkgLibA root)
+                    "<.a library (register) path parser>"
+                    archivePath
+    need [ root -/- relativePackageDbPath stage
+                -/- (pkgId name version) ++ ".conf"
+         ]
+
 -- | Build a static library ('LibA') under the given build root, whose path is
 -- the second argument.
 buildStaticLib :: FilePath -> FilePath -> Action ()
@@ -46,6 +62,21 @@ buildStaticLib root archivePath = do
         (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").")
         archivePath synopsis
 
+-- | Register (with ghc-pkg) a dynamic library ('LibDyn') under the given build
+-- root, with the given suffix (@.so@ or @.dylib@, @.dll@ in the future), where
+-- the complete path of the registered dynamic library is given as the third
+-- argument.
+registerDynamicLibUnix :: FilePath -> String -> FilePath -> Action ()
+registerDynamicLibUnix root suffix dynlibpath = do
+    -- Simply need the ghc-pkg database .conf file.
+    (GhcPkgPath _ stage _ (LibDyn name version _ _))
+        <- parsePath (parseGhcPkgLibDyn root suffix)
+                            "<dyn register lib parser>"
+                            dynlibpath
+    need [ root -/- relativePackageDbPath stage
+                -/- pkgId name version ++ ".conf"
+         ]
+
 -- | Build a dynamic library ('LibDyn') under the given build root, with the
 -- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete
 -- path of the archive to build is given as the third argument.
@@ -54,7 +85,7 @@ buildDynamicLibUnix root suffix dynlibpath = do
     dynlib <- parsePath (parseBuildLibDyn root suffix) "<dyn lib parser>" dynlibpath
     let context = libDynContext dynlib
     deps <- contextDependencies context
-    need =<< mapM pkgLibraryFile deps
+    need =<< mapM pkgRegisteredLibraryFile deps
 
     -- TODO should this be somewhere else?
     -- Custom build step to generate libffi.so* in the rts build directory.
@@ -156,6 +187,16 @@ libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) =
   where
     pkg = library pkgname pkgpath
 
+-- | Parse a path to a registered ghc-pkg static library to be built, making
+-- sure the path starts with the given build root.
+parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA)
+parseGhcPkgLibA root
+    = parseGhcPkgPath root
+        (do -- Skip past pkgId directory.
+            _ <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/")
+            parseLibAFilename)
+        Parsec.<?> "ghc-pkg path for a static library"
+
 -- | Parse a path to a static library to be built, making sure the path starts
 -- with the given build root.
 parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA)
@@ -174,6 +215,12 @@ parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath Lib
 parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext)
     Parsec.<?> ("build path for a dynamic library with extension " ++ ext)
 
+-- | Parse a path to a registered ghc-pkg dynamic library, making sure the path
+-- starts with the given package database root.
+parseGhcPkgLibDyn :: FilePath -> String -> Parsec.Parsec String () (GhcPkgPath LibDyn)
+parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext)
+    Parsec.<?> ("ghc-pkg path for a dynamic library with extension " ++ ext)
+
 -- | Parse the filename of a static library to be built into a 'LibA' value.
 parseLibAFilename :: Parsec.Parsec String () LibA
 parseLibAFilename = do
@@ -202,3 +249,7 @@ parseLibDynFilename ext = do
     _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion
     _ <- Parsec.string ("." ++ ext)
     return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib)
+
+-- | Get the package identifier given the package name and version.
+pkgId :: String -> [Integer] -> String
+pkgId name version = name ++ "-" ++ intercalate "." (map show version)
\ No newline at end of file


=====================================
hadrian/src/Rules/Program.hs
=====================================
@@ -89,6 +89,15 @@ buildProgram bin ctx@(Context{..}) rs = do
     -- Haddock has a resource folder
     need =<< haddockDeps stage
 
+  -- Need library dependencies.
+  -- Note pkgLibraryFile gets the path in the build dir e.g.
+  --    _build/stage1/libraries/haskeline/build/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so
+  -- but when building the program, we link against the *ghc-pkg registered* library e.g.
+  --    _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so
+  -- so we use pkgRegisteredLibraryFile instead.
+  need =<< mapM pkgRegisteredLibraryFile
+       =<< contextDependencies ctx
+
   cross <- flag CrossCompiling
   -- For cross compiler, copy @stage0/bin/<pgm>@ to @stage1/bin/@.
   case (cross, stage) of


=====================================
hadrian/src/Rules/Rts.hs
=====================================
@@ -7,10 +7,10 @@ import Settings.Builders.Common
 -- | Dynamic RTS library files need symlinks without the dummy version number.
 -- This is for backwards compatibility (the old make build system omitted the
 -- dummy version number).
--- This rule has priority 2 to override the general rule for generating share
+-- This rule has priority 3 to override the general rule for generating shared
 -- library files (see Rules.Library.libraryRules).
 rtsRules :: Rules ()
-rtsRules = priority 2 $ do
+rtsRules = priority 3 $ do
     root <- buildRootRules
     [ root -/- "//libHSrts_*-ghc*.so",
       root -/- "//libHSrts_*-ghc*.dylib",


=====================================
hadrian/src/Settings/Builders/Happy.hs
=====================================
@@ -3,7 +3,7 @@ module Settings.Builders.Happy (happyBuilderArgs) where
 import Settings.Builders.Common
 
 happyBuilderArgs :: Args
-happyBuilderArgs = builder Happy ? mconcat [ arg "-ag" -- TODO (int-index): restore the -c option when happy/pull/134 is merged.
+happyBuilderArgs = builder Happy ? mconcat [ arg "-agc"
                                            , arg "--strict"
                                            , arg =<< getInput
                                            , arg "-o", arg =<< getOutput ]


=====================================
libraries/base/GHC/Generics.hs
=====================================
@@ -1434,6 +1434,30 @@ deriving instance Generic ((,,,,,) a b c d e f)
 -- | @since 4.6.0.0
 deriving instance Generic ((,,,,,,) a b c d e f g)
 
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,) a b c d e f g h)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,) a b c d e f g h i)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,) a b c d e f g h i j)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,,) a b c d e f g h i j k)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,,,) a b c d e f g h i j k l)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,,,,) a b c d e f g h i j k l m)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,,,,,) a b c d e f g h i j k l m n)
+
+-- | @since 4.14.0.0
+deriving instance Generic ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o)
+
 -- | @since 4.12.0.0
 deriving instance Generic (Down a)
 
@@ -1471,6 +1495,30 @@ deriving instance Generic1 ((,,,,,) a b c d e)
 -- | @since 4.6.0.0
 deriving instance Generic1 ((,,,,,,) a b c d e f)
 
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,) a b c d e f g)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,) a b c d e f g h)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,) a b c d e f g h i)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,,) a b c d e f g h i j)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,,,) a b c d e f g h i j k)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,,,,) a b c d e f g h i j k l)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n)
+
 -- | @since 4.12.0.0
 deriving instance Generic1 Down
 


=====================================
mk/config.mk.in
=====================================
@@ -858,8 +858,7 @@ HAPPY_VERSION		= @HappyVersion@
 #
 # Options to pass to Happy when we're going to compile the output with GHC
 #
-# TODO (int-index): restore the -c option when happy/pull/134 is merged.
-SRC_HAPPY_OPTS		= -ag --strict
+SRC_HAPPY_OPTS		= -agc --strict
 
 #
 # Alex


=====================================
testsuite/.gitignore
=====================================
@@ -694,6 +694,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk
 /tests/ffi/should_run/Capi_Ctype_002
 /tests/ffi/should_run/Capi_Ctype_A_001.hs
 /tests/ffi/should_run/Capi_Ctype_A_002.hs
+/tests/ffi/should_run/T493
 /tests/ffi/should_run/T1288
 /tests/ffi/should_run/T1679
 /tests/ffi/should_run/T2276


=====================================
testsuite/tests/ffi/should_run/T493.hs
=====================================
@@ -0,0 +1,41 @@
+import Foreign
+import Foreign.C
+
+-- These newtypes...
+newtype MyFunPtr a = MyFunPtr { getFunPtr :: FunPtr a }
+newtype MyPtr a = MyPtr (Ptr a)
+newtype MyIO a = MyIO { runIO :: IO a }
+-- should be supported by...
+
+-- foreign import dynamics
+foreign import ccall "dynamic"
+    mkFun1 :: MyFunPtr (CInt -> CInt) -> (CInt -> CInt)
+foreign import ccall "dynamic"
+    mkFun2 :: MyPtr (Int32 -> Int32) -> (CInt -> CInt)
+
+-- and foreign import wrappers.
+foreign import ccall "wrapper"
+    mkWrap1 :: (CInt -> CInt) -> MyIO (MyFunPtr (CInt -> CInt))
+foreign import ccall "wrapper"
+    mkWrap2 :: (CInt -> CInt) -> MyIO (MyPtr (Int32 -> Int32))
+
+-- We'll need a dynamic function point to export
+foreign import ccall "getDbl" getDbl :: IO (MyFunPtr (CInt -> CInt))
+-- and a Haskell function to export
+half :: CInt -> CInt
+half = (`div` 2)
+-- and a C function to pass it to.
+foreign import ccall "apply" apply1 :: MyFunPtr (CInt -> CInt) -> Int -> Int
+foreign import ccall "apply" apply2 :: MyPtr (Int32 -> Int32) -> Int -> Int
+
+main :: IO ()
+main = do
+
+  dbl <- getDbl
+  let dbl1 = mkFun1 dbl
+      dbl2 = mkFun2 $ MyPtr $ castFunPtrToPtr $ getFunPtr dbl
+  print (dbl1 21, dbl2 21)
+
+  half1 <- runIO $ mkWrap1 half
+  half2 <- runIO $ mkWrap2 half
+  print (apply1 half1 84, apply2 half2 84)


=====================================
testsuite/tests/ffi/should_run/T493.stdout
=====================================
@@ -0,0 +1,2 @@
+(42,42)
+(42,42)


=====================================
testsuite/tests/ffi/should_run/T493_c.c
=====================================
@@ -0,0 +1,16 @@
+typedef int (*intfun_p)(int);
+
+int dbl(int x)
+{
+        return x*2;
+}
+
+intfun_p getDbl(void)
+{
+        return dbl;
+}
+
+int apply(intfun_p f, int x)
+{
+        return f(x);
+}


=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -198,3 +198,5 @@ test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c'
 test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c'])
 
 test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c'])
+
+test('T493', [], compile_and_run, ['T493_c.c'])


=====================================
testsuite/tests/ghci/scripts/T8113.script
=====================================
@@ -1,4 +1,4 @@
-:def type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "")
+:def! type (\e -> putStrLn ("called :type for "++show e++" (ignoring)") >> return "")
 :def
 :t ()
 :ty True


=====================================
testsuite/tests/ghci/scripts/ghci005.stdout
=====================================
@@ -3,7 +3,7 @@ the following macros are defined:
 echo
 hello, world!
 hello, world!
-macro 'echo' is already defined
+macro 'echo' is already defined.  Use ':def!' to overwrite.
 HELLO, WORLD!
 hello, world!
 macro 'f' is not defined


=====================================
testsuite/tests/ghci/should_run/T13456.script
=====================================
@@ -0,0 +1,13 @@
+let macro _ = putStrLn "I'm a macro" >> return ""
+:def ! macro
+:def type macro
+:def ty macro
+:def! type macro
+:type macro
+:t macro
+::t macro
+::type macro
+:def test macro
+:def test macro
+:def! test macro
+:def


=====================================
testsuite/tests/ghci/should_run/T13456.stdout
=====================================
@@ -0,0 +1,11 @@
+macro name cannot start with an exclamation mark
+macro 'type' overwrites builtin command.  Use ':def!' to overwrite.
+macro 'ty' overwrites builtin command.  Use ':def!' to overwrite.
+I'm a macro
+I'm a macro
+macro :: p -> IO [Char]
+macro :: p -> IO [Char]
+macro 'test' is already defined.  Use ':def!' to overwrite.
+the following macros are defined:
+test
+type


=====================================
testsuite/tests/ghci/should_run/all.T
=====================================
@@ -32,6 +32,7 @@ test('T12128',     just_ghci, ghci_script, ['T12128.script'])
 test('T12456',     just_ghci, ghci_script, ['T12456.script'])
 test('T12525',     just_ghci, ghci_script, ['T12525.script'])
 test('T12549',     just_ghci, ghci_script, ['T12549.script'])
+test('T13456',     [just_ghci, combined_output], ghci_script, ['T13456.script'])
 test('BinaryArray', normal, compile_and_run, [''])
 test('T14125a',    just_ghci, ghci_script, ['T14125a.script'])
 test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c44388dec645aa4e85966dcd4de61fbe281811de...b6f8bc7bc6e25895b3b3dd36526a2a9bd1bc4b7e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/c44388dec645aa4e85966dcd4de61fbe281811de...b6f8bc7bc6e25895b3b3dd36526a2a9bd1bc4b7e
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/20190511/6d4a6170/attachment-0001.html>


More information about the ghc-commits mailing list