diff options
| author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2021-02-17 15:59:26 +0100 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2021-04-07 18:37:46 -0400 |
| commit | 9a7e3ee99efe5f8d07924376e4ba3ff66229f873 (patch) | |
| tree | 64be5beb7356d370f2e35b73e8b0d28f95532d4b | |
| parent | b9d45873394c9af2f4376f4b9a551c831d9ac23a (diff) | |
| download | haskell-9a7e3ee99efe5f8d07924376e4ba3ff66229f873.tar.gz | |
Fix Storeable instances for the windows timeout executable.
alignment clearly should be a power of two. This patch makes it
so. We do so by using the #alignment directive instead of using
the size of the type.
(cherry picked from commit 847b0a6950ffdead534d0d4982f50ad17ae7cce0)
| -rw-r--r-- | compiler/GHC/Core/Opt/DmdAnal.hs | 4 | ||||
| -rw-r--r-- | testsuite/timeout/WinCBindings.hsc | 4 |
2 files changed, 6 insertions, 2 deletions
diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs index a9ecee8f59..1cf34c2ff8 100644 --- a/compiler/GHC/Core/Opt/DmdAnal.hs +++ b/compiler/GHC/Core/Opt/DmdAnal.hs @@ -331,6 +331,10 @@ dmdAnal' env dmd (Let (Rec pairs) body) body_ty2 `seq` (body_ty2, Let (Rec pairs') body') +deleteFVs :: DmdType -> [Var] -> DmdType +deleteFVs (DmdType fvs dmds res) bndrs + = DmdType (delVarEnvList fvs bndrs) dmds res + -- | A simple, syntactic analysis of whether an expression MAY throw a precise -- exception when evaluated. It's always sound to return 'True'. -- See Note [Which scrutinees may throw precise exceptions]. diff --git a/testsuite/timeout/WinCBindings.hsc b/testsuite/timeout/WinCBindings.hsc index 36379301a4..3c6b62926c 100644 --- a/testsuite/timeout/WinCBindings.hsc +++ b/testsuite/timeout/WinCBindings.hsc @@ -28,7 +28,7 @@ data PROCESS_INFORMATION = PROCESS_INFORMATION instance Storable PROCESS_INFORMATION where sizeOf = const #size PROCESS_INFORMATION - alignment = sizeOf + alignment = const #alignment PROCESS_INFORMATION poke buf pi = do (#poke PROCESS_INFORMATION, hProcess) buf (piProcess pi) (#poke PROCESS_INFORMATION, hThread) buf (piThread pi) @@ -67,7 +67,7 @@ data STARTUPINFO = STARTUPINFO instance Storable STARTUPINFO where sizeOf = const #size STARTUPINFO - alignment = sizeOf + alignment = const #alignment STARTUPINFO poke buf si = do (#poke STARTUPINFO, cb) buf (siCb si) (#poke STARTUPINFO, lpDesktop) buf (siDesktop si) |