From 581e25960e9af2e07a15101306493be46f1587e9 Mon Sep 17 00:00:00 2001 From: David Date: Tue, 21 Sep 2021 14:08:41 +0200 Subject: [PATCH 1/8] Made some type variables existential in the Idx pattern synonyms --- src/Data/Array/Accelerate/AST/Idx.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Data/Array/Accelerate/AST/Idx.hs b/src/Data/Array/Accelerate/AST/Idx.hs index 739a0452e..4db9f2057 100644 --- a/src/Data/Array/Accelerate/AST/Idx.hs +++ b/src/Data/Array/Accelerate/AST/Idx.hs @@ -76,12 +76,12 @@ newtype Idx env t = UnsafeIdxConstructor { unsafeRunIdx :: Int } {-# COMPLETE ZeroIdx, SuccIdx #-} -pattern ZeroIdx :: forall env envt t. () => (envt ~ (env, t)) => Idx envt t -pattern ZeroIdx <- (\x -> (idxToInt x, unsafeCoerce @(envt :~: envt) @(envt :~: (env, t)) Refl) -> (0, Refl)) +pattern ZeroIdx :: forall envt t. () => forall env. (envt ~ (env, t)) => Idx envt t +pattern ZeroIdx <- (\x -> (idxToInt x, unsafeCoerce @_ @(envt :~: (_, t)) Refl) -> (0, Refl)) where ZeroIdx = UnsafeIdxConstructor 0 -pattern SuccIdx :: () => (envs ~ (env, s)) => Idx env t -> Idx envs t +pattern SuccIdx :: forall envs t. () => forall s env. (envs ~ (env, s)) => Idx env t -> Idx envs t pattern SuccIdx idx <- (unSucc -> Just (idx, Refl)) where SuccIdx (UnsafeIdxConstructor i) = UnsafeIdxConstructor (i+1) From 2cacc813fd93ab68cd66b09addabe07b16950f44 Mon Sep 17 00:00:00 2001 From: David Date: Tue, 21 Sep 2021 14:49:00 +0200 Subject: [PATCH 2/8] Move type annotation --- src/Data/Array/Accelerate/AST/Idx.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Data/Array/Accelerate/AST/Idx.hs b/src/Data/Array/Accelerate/AST/Idx.hs index 4db9f2057..ee1634ca9 100644 --- a/src/Data/Array/Accelerate/AST/Idx.hs +++ b/src/Data/Array/Accelerate/AST/Idx.hs @@ -6,7 +6,6 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_HADDOCK hide #-} @@ -77,7 +76,7 @@ newtype Idx env t = UnsafeIdxConstructor { unsafeRunIdx :: Int } {-# COMPLETE ZeroIdx, SuccIdx #-} pattern ZeroIdx :: forall envt t. () => forall env. (envt ~ (env, t)) => Idx envt t -pattern ZeroIdx <- (\x -> (idxToInt x, unsafeCoerce @_ @(envt :~: (_, t)) Refl) -> (0, Refl)) +pattern ZeroIdx <- (\x -> (idxToInt x, unsafeCoerce Refl) -> (0, Refl :: envt :~: (env, t))) where ZeroIdx = UnsafeIdxConstructor 0 From 3fe2cfbc42abc6c4efa2bb6f634ce148e7ac4d70 Mon Sep 17 00:00:00 2001 From: Robbert van der Helm Date: Mon, 1 Nov 2021 13:30:55 +0100 Subject: [PATCH 3/8] Properly mark the doctests module as generated `other-modules` are supposed to exist, and specifying generating modules there is now a hard error. --- accelerate.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/accelerate.cabal b/accelerate.cabal index 0b95607e4..55cf202b1 100644 --- a/accelerate.cabal +++ b/accelerate.cabal @@ -587,7 +587,7 @@ test-suite doctest default-language: Haskell2010 hs-source-dirs: test/doctest main-is: Main.hs - other-modules: Build_doctests + autogen-modules: Build_doctests build-depends: base >= 4.10 From 98a147451f2426861c1a9f60d9606a92484fd9ea Mon Sep 17 00:00:00 2001 From: Robbert van der Helm Date: Mon, 1 Nov 2021 14:22:53 +0100 Subject: [PATCH 4/8] Add missing tracy client files to sdist Otherwise you wouldn't be able to compile with the debug flag since some of Tracy's includes would be missing. --- accelerate.cabal | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/accelerate.cabal b/accelerate.cabal index 55cf202b1..da741a2a0 100644 --- a/accelerate.cabal +++ b/accelerate.cabal @@ -137,6 +137,7 @@ extra-source-files: CHANGELOG.md cbits/*.c cbits/*.h + -- These are referenced directly using the FFI cbits/tracy/*.h cbits/tracy/*.hpp cbits/tracy/*.cpp @@ -146,6 +147,10 @@ extra-source-files: cbits/tracy/client/*.h cbits/tracy/client/*.hpp cbits/tracy/client/*.cpp + -- Used by the Tracy's client + cbits/tracy/libbacktrace/*.h + cbits/tracy/libbacktrace/*.hpp + cbits/tracy/libbacktrace/*.cpp extra-doc-files: images/*.png From d54182cfa2888f1ce741e435cb02ba2d0dd8ce68 Mon Sep 17 00:00:00 2001 From: Robbert van der Helm Date: Mon, 1 Nov 2021 14:38:28 +0100 Subject: [PATCH 5/8] Add sources for Tracy utilities to the sdist Otherwise the build in Setup.hs will fail. --- accelerate.cabal | 38 +++++++++++++++++++++++++++++++++++++- 1 file changed, 37 insertions(+), 1 deletion(-) diff --git a/accelerate.cabal b/accelerate.cabal index da741a2a0..c581fb62c 100644 --- a/accelerate.cabal +++ b/accelerate.cabal @@ -147,10 +147,46 @@ extra-source-files: cbits/tracy/client/*.h cbits/tracy/client/*.hpp cbits/tracy/client/*.cpp - -- Used by the Tracy's client + -- These are used to build Tracy's client tools in Setup.hs + cbits/tracy/capture/build/unix/Makefile + cbits/tracy/capture/build/unix/*.mk + cbits/tracy/profiler/build/unix/Makefile + cbits/tracy/profiler/build/unix/*.mk + cbits/tracy/common/*.mk + -- The Makefiles fetch the source files from these Visual Studio project + -- files + cbits/tracy/capture/build/win32/capture.vcxproj + cbits/tracy/capture/build/win32/capture.vcxproj.filters + cbits/tracy/profiler/build/win32/Tracy.vcxproj + cbits/tracy/profiler/build/win32/Tracy.vcxproj.filters + -- Used by the Tracy's client tools + cbits/tracy/capture/src/*.cpp + cbits/tracy/imgui/*.h + cbits/tracy/imgui/*.cpp + cbits/tracy/imgui/misc/freetype/*.h + cbits/tracy/imgui/misc/freetype/*.cpp cbits/tracy/libbacktrace/*.h cbits/tracy/libbacktrace/*.hpp cbits/tracy/libbacktrace/*.cpp + cbits/tracy/nfd/*.h + cbits/tracy/nfd/*.c + cbits/tracy/profiler/src/*.h + cbits/tracy/profiler/src/*.hpp + cbits/tracy/profiler/src/*.cpp + cbits/tracy/profiler/libs/gl3w/GL/*.h + cbits/tracy/profiler/libs/gl3w/GL/*.c + cbits/tracy/server/*.h + cbits/tracy/server/*.hpp + cbits/tracy/server/*.cpp + cbits/tracy/zstd/*.h + cbits/tracy/zstd/common/*.h + cbits/tracy/zstd/common/*.c + cbits/tracy/zstd/compress/*.h + cbits/tracy/zstd/compress/*.c + cbits/tracy/zstd/decompress/*.h + cbits/tracy/zstd/decompress/*.c + cbits/tracy/zstd/dictBuilder/*.h + cbits/tracy/zstd/dictBuilder/*.c extra-doc-files: images/*.png From e30e10c2bd14f9935704d52df5ab7ceafe8155b0 Mon Sep 17 00:00:00 2001 From: Robbert van der Helm Date: Tue, 2 Nov 2021 14:02:51 +0100 Subject: [PATCH 6/8] Gitignore dist-newstyle/ --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 2dc9bad21..39752ee64 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ /.ghci /dist/ +/dist-newstyle/ /accelerate-examples/dist /accelerate-buildbot/dist /accelerate-cuda/dist/ From 60083771ede2c98a3ab5125954b61643acfe841f Mon Sep 17 00:00:00 2001 From: Robbert van der Helm Date: Wed, 3 Nov 2021 13:45:25 +0100 Subject: [PATCH 7/8] Gitignore local overrides from cabal configure --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 39752ee64..1467ca972 100644 --- a/.gitignore +++ b/.gitignore @@ -9,6 +9,7 @@ /accelerate-cuda/cubits/accelerate_cuda_shape.h /accelerate-io/dist/ /.stack-work +/cabal.project.local* /stack.yaml /stack.yaml.lock .DS_Store From 286781b4b55f9ffa5965decf3165a68d209e7dc9 Mon Sep 17 00:00:00 2001 From: Robbert van der Helm Date: Wed, 3 Nov 2021 14:58:24 +0100 Subject: [PATCH 8/8] Add more FFI stubs for hls Just like in #491. This is not strictly related to Cabal, but these only get triggered when using hls with the default Cabal cradle. --- .../Array/Accelerate/Debug/Internal/Clock.hs | 18 ++++++++++- .../Accelerate/Debug/Internal/Profile.hs | 31 +++++++++++++++++++ .../Array/Accelerate/Debug/Internal/Tracy.hs | 8 +++-- 3 files changed, 54 insertions(+), 3 deletions(-) diff --git a/src/Data/Array/Accelerate/Debug/Internal/Clock.hs b/src/Data/Array/Accelerate/Debug/Internal/Clock.hs index 465b5f9f2..229f3ac82 100644 --- a/src/Data/Array/Accelerate/Debug/Internal/Clock.hs +++ b/src/Data/Array/Accelerate/Debug/Internal/Clock.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fobject-code #-} @@ -16,12 +17,27 @@ module Data.Array.Accelerate.Debug.Internal.Clock import Language.Haskell.TH.Syntax +-- FIXME: HLS requires stubs because it does not process the +-- 'addForeignFilePath' calls when evaluating Template Haskell +-- +-- https://github.com/haskell/haskell-language-server/issues/365 +#ifndef __GHCIDE__ + foreign import ccall unsafe "clock_gettime_monotonic_seconds" getMonotonicTime :: IO Double foreign import ccall unsafe "clock_gettime_elapsed_seconds" getProgramTime :: IO Double +#else + +getMonotonicTime :: IO Double +getMonotonicTime = undefined + +getProgramTime :: IO Double +getProgramTime = undefined + +#endif + -- SEE: [linking to .c files] -- runQ $ do addForeignFilePath LangC "cbits/clock.c" return [] - diff --git a/src/Data/Array/Accelerate/Debug/Internal/Profile.hs b/src/Data/Array/Accelerate/Debug/Internal/Profile.hs index baddb1e7b..b5c17a2dc 100644 --- a/src/Data/Array/Accelerate/Debug/Internal/Profile.hs +++ b/src/Data/Array/Accelerate/Debug/Internal/Profile.hs @@ -144,6 +144,12 @@ emit_remote_gc = void $ Atomic.add __num_remote_gcs 1 -- Monitoring variables -- -------------------- +-- FIXME: HLS requires stubs because it does not process the +-- 'addForeignFilePath' calls when evaluating Template Haskell +-- +-- https://github.com/haskell/haskell-language-server/issues/365 +#ifndef __GHCIDE__ + foreign import ccall "&__total_bytes_allocated_local" __total_bytes_allocated_local :: Atomic -- bytes allocated in the local (CPU) memory space foreign import ccall "&__total_bytes_allocated_remote" __total_bytes_allocated_remote :: Atomic -- bytes allocated in the remote memory space (if it is separate, e.g. GPU) foreign import ccall "&__total_bytes_copied_to_remote" __total_bytes_copied_to_remote :: Atomic -- bytes copied to the remote memory space @@ -152,6 +158,31 @@ foreign import ccall "&__total_bytes_evicted_from_remote" __total_bytes_evicted_ foreign import ccall "&__num_remote_gcs" __num_remote_gcs :: Atomic -- number of times the remote memory space was forcibly garbage collected foreign import ccall "&__num_evictions" __num_evictions :: Atomic -- number of LRU eviction events +#else + +__total_bytes_allocated_local :: Atomic +__total_bytes_allocated_local = undefined + +__total_bytes_allocated_remote :: Atomic +__total_bytes_allocated_remote = undefined + +__total_bytes_copied_to_remote :: Atomic +__total_bytes_copied_to_remote = undefined + +__total_bytes_copied_from_remote :: Atomic +__total_bytes_copied_from_remote = undefined + +__total_bytes_evicted_from_remote :: Atomic +__total_bytes_evicted_from_remote = undefined + +__num_remote_gcs :: Atomic +__num_remote_gcs = undefined + +__num_evictions :: Atomic +__num_evictions = undefined + +#endif + -- SEE: [linking to .c files] -- runQ $ do diff --git a/src/Data/Array/Accelerate/Debug/Internal/Tracy.hs b/src/Data/Array/Accelerate/Debug/Internal/Tracy.hs index 7dce6dac0..cfe9dc1b2 100644 --- a/src/Data/Array/Accelerate/Debug/Internal/Tracy.hs +++ b/src/Data/Array/Accelerate/Debug/Internal/Tracy.hs @@ -20,14 +20,18 @@ import Foreign.C.String import Foreign.C.Types import Foreign.Ptr -#ifdef ACCELERATE_DEBUG +#if defined(ACCELERATE_DEBUG) && !defined(__GHCIDE__) import Language.Haskell.TH.Syntax #endif type Zone = Word64 type SrcLoc = Word64 -#ifdef ACCELERATE_DEBUG +-- FIXME: HLS requires stubs because it does not process the +-- 'addForeignFilePath' calls when evaluating Template Haskell +-- +-- https://github.com/haskell/haskell-language-server/issues/365 +#if defined(ACCELERATE_DEBUG) && !defined(__GHCIDE__) foreign import ccall unsafe "___tracy_init_thread" init_thread :: IO () foreign import ccall unsafe "___tracy_set_thread_name" set_thread_name :: CString -> IO ()