Merge branch 'master' into featureset

Author: isovector

.gitignore

@@ -30,3 +30,6 @@ test/testdata/**/hie.yaml
 
 # shake build folder (used in benchmark suite)
 .shake/
+
+# pre-commit-hook.nix
+.pre-commit-config.yaml

.stylish-haskell.yaml

@@ -0,0 +1,63 @@
+# See https://github.com/jaspervdj/stylish-haskell/blob/main/data/stylish-haskell.yaml
+# for reference.
+
+steps:
+  # - unicode_syntax:
+  #     add_language_pragma: true
+
+  # - module_header:
+  #     indent: 4
+  #     sort: true
+  #     separate_lists: true
+
+  # - records:
+  #     equals: "indent 2"
+  #     first_field: "indent 2"
+  #     field_comment: 2
+  #     deriving: 2
+  #     via: "indent 2"
+  #     sort_deriving: true
+  #     break_enums: false
+  #     break_single_constructors: true
+  #     curried_context: false
+
+  - simple_align:
+      cases: always
+      top_level_patterns: always
+      records: always
+      multi_way_if: always
+
+  - imports:
+      align: global
+      list_align: after_alias
+      pad_module_names: true
+      long_list_align: inline
+      empty_list_align: inherit
+      list_padding: 4
+      separate_lists: true
+      space_surround: false
+      ghc_lib_parser: false
+
+  - language_pragmas:
+      style: vertical
+      align: true
+      remove_redundant: true
+      language_prefix: LANGUAGE
+
+  # - tabs:
+  #     spaces: 8
+
+  - trailing_whitespace: {}
+
+  # - squash: {}
+
+columns: 80
+
+newline: native
+
+language_extensions:
+  - DataKinds
+  - OverloadedStrings
+  - TypeOperators
+
+cabal: true

CONTRIBUTING.md

@@ -1,5 +1,40 @@
 # Contributors Guide
 
+## Pre-commit hook
+We are using [pre-commit-hook.nix](https://github.com/cachix/pre-commit-hooks.nix) to configure git pre-commit hook for formatting. Although it is possible to run formatting manually, we recommend you to use it to set pre-commit hook as our CI checks pre-commit hook is applied or not.
+
+You can configure the pre-commit-hook by running
+
+``` bash
+nix-shell
+```
+
+If you don't want to use [nix](https://nixos.org/guides/install-nix.html), you can instead use [pre-commit](https://pre-commit.com) with the following config.
+
+```json
+{
+  "repos": [
+    {
+      "hooks": [
+        {
+          "entry": "stylish-haskell -i ",
+          "exclude": "(/test/testdata/*)",
+          "files": "\\.l?hs$",
+          "id": "stylish-haskell",
+          "language": "system",
+          "name": "stylish-haskell",
+          "pass_filenames": true,
+          "types": [
+            "file"
+          ]
+        }
+      ],
+      "repo": "local"
+    }
+  ]
+}
+```
+
 ## Testing
 
 The tests make use of the [Tasty](https://github.com/feuerbach/tasty) test framework.

ChangeLog.md

@@ -32,5 +32,5 @@ main = do
 
   forM_ prsAfterLastTag $ \SimplePullRequest{..} ->
     putStrLn $ T.unpack $ "- " <> simplePullRequestTitle <>
-      "\n([#" <> T.pack (show $ unIssueNumber simplePullRequestNumber) <> ")](" <> getUrl simplePullRequestHtmlUrl <> ")" <>
+      "\n([#" <> T.pack (show $ unIssueNumber simplePullRequestNumber) <> "](" <> getUrl simplePullRequestHtmlUrl <> "))" <>
       " by @" <> untagName (simpleUserLogin simplePullRequestUser)

GenChangelogs.hs

@@ -0,0 +1,74 @@
+# See https://github.com/jaspervdj/stylish-haskell/blob/main/data/stylish-haskell.yaml
+# for reference.
+
+steps:
+  # - unicode_syntax:
+  #     add_language_pragma: true
+
+  # - module_header:
+  #     indent: 4
+  #     sort: true
+  #     separate_lists: true
+
+  # - records:
+  #     equals: "indent 2"
+  #     first_field: "indent 2"
+  #     field_comment: 2
+  #     deriving: 2
+  #     via: "indent 2"
+  #     sort_deriving: true
+  #     break_enums: false
+  #     break_single_constructors: true
+  #     curried_context: false
+
+  - simple_align:
+      cases: always
+      top_level_patterns: always
+      records: always
+      multi_way_if: always
+
+  - imports:
+      align: global
+      list_align: after_alias
+      pad_module_names: true
+      long_list_align: inline
+      empty_list_align: inherit
+      list_padding: 4
+      separate_lists: true
+      space_surround: false
+      ghc_lib_parser: false
+
+  - language_pragmas:
+      style: vertical
+      align: true
+      remove_redundant: true
+      language_prefix: LANGUAGE
+
+  # - tabs:
+  #     spaces: 8
+
+  - trailing_whitespace: {}
+
+  # - squash: {}
+
+columns: 80
+
+newline: native
+
+language_extensions:
+  - BangPatterns
+  - DeriveFunctor
+  - DeriveGeneric
+  - FlexibleContexts
+  - GeneralizedNewtypeDeriving
+  - LambdaCase
+  - NamedFieldPuns
+  - OverloadedStrings
+  - RecordWildCards
+  - ScopedTypeVariables
+  - StandaloneDeriving
+  - TupleSections
+  - TypeApplications
+  - ViewPatterns
+
+cabal: true

ghcide/.stylish-haskell.yaml

@@ -27,6 +27,11 @@ source-repository head
     type:     git
     location: https://github.com/haskell/ghcide.git
 
+flag ghc-patched-unboxed-bytecode
+    description: The GHC version we link against supports unboxed sums and tuples in bytecode
+    default:     False
+    manual:      True
+
 library
     default-language:   Haskell2010
     build-depends:
@@ -190,6 +195,9 @@ library
         Development.IDE.Types.Action
     ghc-options: -Wall -Wno-name-shadowing -Wincomplete-uni-patterns -Wno-unticked-promoted-constructors
 
+    if flag(ghc-patched-unboxed-bytecode)
+      cpp-options: -DGHC_PATCHED_UNBOXED_BYTECODE
+
 executable ghcide-test-preprocessor
     default-language: Haskell2010
     hs-source-dirs: test/preprocessor

ghcide/ghcide.cabal

@@ -325,7 +325,12 @@ generateObjectCode session summary guts = do
               (warnings, dot_o_fp) <-
                 withWarnings "object" $ \_tweak -> do
                       let summary' = _tweak summary
-                          session' = session { hsc_dflags = (ms_hspp_opts summary') { outputFile = Just dot_o }}
+#if MIN_GHC_API_VERSION(8,10,0)
+                          target = defaultObjectTarget $ hsc_dflags session
+#else
+                          target = defaultObjectTarget $ targetPlatform $ hsc_dflags session
+#endif
+                          session' = session { hsc_dflags = updOptLevel 0 $ (ms_hspp_opts summary') { outputFile = Just dot_o , hscTarget = target}}
                       (outputFilename, _mStub, _foreign_files) <- hscGenHardCode session' guts
 #if MIN_GHC_API_VERSION(8,10,0)
                                 (ms_location summary')

ghcide/src/Development/IDE/Core/Compile.hs

@@ -45,7 +45,9 @@ import Data.Int (Int64)
 import GHC.Serialized (Serialized)
 
 data LinkableType = ObjectLinkable | BCOLinkable
-  deriving (Eq,Ord,Show)
+  deriving (Eq,Ord,Show, Generic)
+instance Hashable LinkableType
+instance NFData   LinkableType
 
 -- NOTATION
 --   Foo+ means Foo for the dependencies
@@ -337,7 +339,7 @@ instance NFData   GetLocatedImports
 instance Binary   GetLocatedImports
 
 -- | Does this module need to be compiled?
-type instance RuleResult NeedsCompilation = Bool
+type instance RuleResult NeedsCompilation = Maybe LinkableType
 
 data NeedsCompilation = NeedsCompilation
     deriving (Eq, Show, Typeable, Generic)

ghcide/src/Development/IDE/Core/RuleTypes.hs

@@ -1038,42 +1038,59 @@ getClientConfigAction defValue = do
     Just (Success c) -> return c
     _ -> return defValue
 
--- | For now we always use bytecode
+-- | For now we always use bytecode unless something uses unboxed sums and tuples along with TH
 getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType)
-getLinkableType f = do
-  needsComp <- use_ NeedsCompilation f
-  pure $ if needsComp then Just BCOLinkable else Nothing
+getLinkableType f = use_ NeedsCompilation f
 
 needsCompilationRule :: Rules ()
 needsCompilationRule = defineEarlyCutoff $ \NeedsCompilation file -> do
-  -- It's important to use stale data here to avoid wasted work.
-  -- if NeedsCompilation fails for a module M its result will be  under-approximated
-  -- to False in its dependencies. However, if M actually used TH, this will
-  -- cause a re-evaluation of GetModIface for all dependencies
-  -- (since we don't need to generate object code anymore).
-  -- Once M is fixed we will discover that we actually needed all the object code
-  -- that we just threw away, and thus have to recompile all dependencies once
-  -- again, this time keeping the object code.
-  (ms,_) <- fst <$> useWithStale_ GetModSummaryWithoutTimestamps file
-  -- A file needs object code if it uses TemplateHaskell or any file that depends on it uses TemplateHaskell
-  res <-
-    if uses_th_qq ms
-    then pure True
-    else do
-      graph <- useNoFile GetModuleGraph
-      case graph of
-          -- Treat as False if some reverse dependency header fails to parse
-          Nothing -> pure False
-          Just depinfo -> case immediateReverseDependencies file depinfo of
-            -- If we fail to get immediate reverse dependencies, fail with an error message
-            Nothing -> fail $ "Failed to get the immediate reverse dependencies of " ++ show file
-            Just revdeps -> anyM (fmap (fromMaybe False) . use NeedsCompilation) revdeps
+  graph <- useNoFile GetModuleGraph
+  res <- case graph of
+    -- Treat as False if some reverse dependency header fails to parse
+    Nothing -> pure Nothing
+    Just depinfo -> case immediateReverseDependencies file depinfo of
+      -- If we fail to get immediate reverse dependencies, fail with an error message
+      Nothing -> fail $ "Failed to get the immediate reverse dependencies of " ++ show file
+      Just revdeps -> do
+        -- It's important to use stale data here to avoid wasted work.
+        -- if NeedsCompilation fails for a module M its result will be  under-approximated
+        -- to False in its dependencies. However, if M actually used TH, this will
+        -- cause a re-evaluation of GetModIface for all dependencies
+        -- (since we don't need to generate object code anymore).
+        -- Once M is fixed we will discover that we actually needed all the object code
+        -- that we just threw away, and thus have to recompile all dependencies once
+        -- again, this time keeping the object code.
+        -- A file needs to be compiled if any file that depends on it uses TemplateHaskell or needs to be compiled
+        (ms,_) <- fst <$> useWithStale_ GetModSummaryWithoutTimestamps file
+        (modsums,needsComps) <- par (map (fmap (fst . fst)) <$> usesWithStale GetModSummaryWithoutTimestamps revdeps)
+                                    (uses NeedsCompilation revdeps)
+        pure $ computeLinkableType ms modsums (map join needsComps)
 
   pure (Just $ BS.pack $ show $ hash res, ([], Just res))
   where
     uses_th_qq (ms_hspp_opts -> dflags) =
       xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
 
+    unboxed_tuples_or_sums (ms_hspp_opts -> d) =
+      xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d
+
+    computeLinkableType :: ModSummary -> [Maybe ModSummary] -> [Maybe LinkableType] -> Maybe LinkableType
+    computeLinkableType this deps xs
+      | Just ObjectLinkable `elem` xs     = Just ObjectLinkable -- If any dependent needs object code, so do we
+      | Just BCOLinkable    `elem` xs     = Just this_type      -- If any dependent needs bytecode, then we need to be compiled
+      | any (maybe False uses_th_qq) deps = Just this_type      -- If any dependent needs TH, then we need to be compiled
+      | otherwise                         = Nothing             -- If none of these conditions are satisfied, we don't need to compile
+      where
+        -- How should we compile this module? (assuming we do in fact need to compile it)
+        -- Depends on whether it uses unboxed tuples or sums
+        this_type
+#if defined(GHC_PATCHED_UNBOXED_BYTECODE)
+          = BCOLinkable
+#else
+          | unboxed_tuples_or_sums this = ObjectLinkable
+          | otherwise                   = BCOLinkable
+#endif
+
 -- | Tracks which linkables are current, so we don't need to unload them
 newtype CompiledLinkables = CompiledLinkables { getCompiledLinkables :: Var (ModuleEnv UTCTime) }
 instance IsIdeGlobal CompiledLinkables

ghcide/src/Development/IDE/Core/Rules.hs

@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell, UnboxedTuples #-}
+module THA where
+import Language.Haskell.TH
+
+f :: Int -> (# Int, Int #)
+f x = (# x , x+1 #)
+
+th_a :: DecsQ
+th_a = case f 1 of (# a , b #) -> [d| a = () |]

ghcide/test/data/THUnboxed/THA.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+module THB where
+import THA
+
+$th_a

ghcide/test/data/THUnboxed/THB.hs

@@ -0,0 +1,5 @@
+module THC where
+import THB
+
+c ::()
+c = a

ghcide/test/data/THUnboxed/THC.hs

@@ -0,0 +1 @@
+cradle: {direct: {arguments: ["-Wmissing-signatures", "-package template-haskell", "THA", "THB", "THC"]}}