remove 64 bits assumption

haskell · Mar 3, 2021 · 115d063 · 115d063
1 parent ef2974d
commit 115d063
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 24 deletions.
diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs
@@ -113,7 +113,10 @@ import           TcEnv                             (tcLookup)
 import           Control.Concurrent.Extra
 import           Control.Concurrent.STM            hiding (orElse)
 import           Data.Aeson                        (toJSON)
+import           Data.Binary
+import           Data.Binary.Put
 import           Data.Bits                         (shiftR)
+import qualified Data.ByteString.Lazy              as LBS
 import           Data.Coerce
 import           Data.Functor
 import qualified Data.HashMap.Strict               as HashMap
@@ -759,35 +762,17 @@ getModSummaryFromImports env fp modTime contents = do
         -- Compute a fingerprint from the contents of `ModSummary`,
         -- eliding the timestamps, the preprocessed source and other non relevant fields
         computeFingerprint opts ModSummary{..} = do
-            let moduleUniques =
-                    [ b
-                    | m <- moduleName ms_mod
-                         : map (unLoc . snd) (ms_srcimps ++ ms_textual_imps)
-                    , b <- toBytes $ uniq $ moduleNameFS m
-                    ] ++
-                    [ b
-                    | (Just p, _) <- ms_srcimps ++ ms_textual_imps
-                    , b <- toBytes $ uniq p
-                    ]
-            fingerPrintImports <- withArrayLen moduleUniques $ \len p ->
-                    fingerprintData p len
+            let moduleUniques = runPut $ do
+                  put $ uniq $ moduleNameFS $ moduleName ms_mod
+                  forM_ (ms_srcimps ++ ms_textual_imps) $ \(mb_p, m) -> do
+                    put $ uniq $ moduleNameFS $ unLoc m
+                    whenJust mb_p $ put . uniq
+            fingerPrintImports <- fingerprintFromByteString $ LBS.toStrict moduleUniques
             return $ fingerprintFingerprints $
                     [ fingerprintString fp
                     , fingerPrintImports
                     ] ++ map fingerprintString opts
 
-        toBytes :: Int -> [Word8]
-        toBytes w64 =
-            [ fromIntegral (w64 `shiftR` 56)
-            , fromIntegral (w64 `shiftR` 48)
-            , fromIntegral (w64 `shiftR` 40)
-            , fromIntegral (w64 `shiftR` 32)
-            , fromIntegral (w64 `shiftR` 24)
-            , fromIntegral (w64 `shiftR` 16)
-            , fromIntegral (w64 `shiftR` 8)
-            , fromIntegral w64
-            ]
-
 
 -- | Parse only the module header
 parseHeader

diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs
@@ -19,6 +19,7 @@ module Development.IDE.GHC.Util(
     moduleImportPath,
     cgGutsToCoreModule,
     fingerprintToBS,
+    fingerprintFromByteString,
     fingerprintFromStringBuffer,
     -- * General utilities
     readFileUtf8,
@@ -200,6 +201,11 @@ fingerprintFromStringBuffer :: StringBuffer -> IO Fingerprint
 fingerprintFromStringBuffer (StringBuffer buf len cur) =
     withForeignPtr buf $ \ptr -> fingerprintData (ptr `plusPtr` cur) len
 
+fingerprintFromByteString :: ByteString -> IO Fingerprint
+fingerprintFromByteString bs = do
+    let (fptr, offset, len) = BS.toForeignPtr bs
+    withForeignPtr fptr $ \ptr ->
+        fingerprintData (ptr `plusPtr` offset) len
 
 -- | A slightly modified version of 'hDuplicateTo' from GHC.
 --   Importantly, it avoids the bug listed in https://gitlab.haskell.org/ghc/ghc/merge_requests/2318.