From 78c74b12c8390bf8f9fd402317b8dc3737d49ed0 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 30 Jun 2021 08:32:41 +0100 Subject: [PATCH] rollback NFP interning --- lsp-types/src/Language/LSP/Types/Uri.hs | 23 ++--------------------- 1 file changed, 2 insertions(+), 21 deletions(-) diff --git a/lsp-types/src/Language/LSP/Types/Uri.hs b/lsp-types/src/Language/LSP/Types/Uri.hs index f7355b74b..5fa823674 100644 --- a/lsp-types/src/Language/LSP/Types/Uri.hs +++ b/lsp-types/src/Language/LSP/Types/Uri.hs @@ -25,20 +25,16 @@ import Control.DeepSeq import qualified Data.Aeson as A import Data.Binary (Binary, Get, put, get) import Data.Hashable -import qualified Data.HashMap.Strict as HM -import Data.IORef (atomicModifyIORef', newIORef) import Data.List (stripPrefix) import Data.String (IsString, fromString) import Data.Text (Text) import qualified Data.Text as T -import Data.Tuple (swap) import GHC.Generics import Network.URI hiding (authority) import qualified System.FilePath as FP import qualified System.FilePath.Posix as FPP import qualified System.FilePath.Windows as FPW import qualified System.Info -import System.IO.Unsafe (unsafePerformIO) newtype Uri = Uri { getUri :: Text } deriving (Eq,Ord,Read,Show,Generic,A.FromJSON,A.ToJSON,Hashable,A.ToJSONKey,A.FromJSONKey) @@ -175,7 +171,7 @@ instance Binary NormalizedFilePath where -- | A smart constructor that performs UTF-8 encoding and hash consing normalizedFilePath :: NormalizedUri -> FilePath -> NormalizedFilePath -normalizedFilePath nuri nfp = intern $ NormalizedFilePath nuri nfp +normalizedFilePath nuri nfp = NormalizedFilePath nuri nfp -- | Internal helper that takes a file path that is assumed to -- already be normalized to a URI. It is up to the caller @@ -211,19 +207,4 @@ normalizedFilePathToUri (NormalizedFilePath uri _) = uri uriToNormalizedFilePath :: NormalizedUri -> Maybe NormalizedFilePath uriToNormalizedFilePath nuri = fmap (normalizedFilePath nuri) mbFilePath - where mbFilePath = platformAwareUriToFilePath System.Info.os (fromNormalizedUri nuri) - ---------------------------------------------------------------------------- --- Unsafe hashcons of NFP -internIO :: (Eq a, Hashable a) => IO (a -> IO a) -internIO = do - tableRef <- newIORef mempty - let f x = atomicModifyIORef' tableRef $ swap . flip HM.alterF x (\case - Just res -> (res, Just res) - Nothing -> (x, Just x) - ) - return f - -{-# NOINLINE intern #-} -intern :: NormalizedFilePath -> NormalizedFilePath -intern = let f = unsafePerformIO internIO in \x -> unsafePerformIO (f x) + where mbFilePath = platformAwareUriToFilePath System.Info.os (fromNormalizedUri nuri) \ No newline at end of file