diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/main/DynFlags.hs | 15 | ||||
-rw-r--r-- | compiler/main/DynFlags.hs-boot | 1 | ||||
-rw-r--r-- | compiler/utils/Outputable.lhs | 7 |
3 files changed, 21 insertions, 2 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 66e42b5e8b..3591a30d25 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -169,10 +169,13 @@ import qualified Data.Set as Set import Data.Word import System.FilePath import System.IO +import System.IO.Error import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet +import GHC.Foreign (withCString, peekCString) + -- ----------------------------------------------------------------------------- -- DynFlags @@ -708,6 +711,8 @@ data DynFlags = DynFlags { pprCols :: Int, traceLevel :: Int, -- Standard level is 1. Less verbose is 0. + useUnicodeQuotes :: Bool, + -- | what kind of {-# SCC #-} to add automatically profAuto :: ProfAuto, @@ -1176,6 +1181,12 @@ initDynFlags dflags = do refGeneratedDumps <- newIORef Set.empty refLlvmVersion <- newIORef 28 wrapperNum <- newIORef 0 + canUseUnicodeQuotes <- do let enc = localeEncoding + str = "‛’" + (withCString enc str $ \cstr -> + do str' <- peekCString enc cstr + return (str == str')) + `catchIOError` \_ -> return False return dflags{ canGenerateDynamicToo = refCanGenerateDynamicToo, filesToClean = refFilesToClean, @@ -1183,7 +1194,8 @@ initDynFlags dflags = do filesToNotIntermediateClean = refFilesToNotIntermediateClean, generatedDumps = refGeneratedDumps, llvmVersion = refLlvmVersion, - nextWrapperNum = wrapperNum + nextWrapperNum = wrapperNum, + useUnicodeQuotes = canUseUnicodeQuotes } -- | The normal 'DynFlags'. Note that they is not suitable for use in this form @@ -1308,6 +1320,7 @@ defaultDynFlags mySettings = flushErr = defaultFlushErr, pprUserLength = 5, pprCols = 100, + useUnicodeQuotes = False, traceLevel = 1, profAuto = NoProfAuto, llvmVersion = panic "defaultDynFlags: No llvmVersion", diff --git a/compiler/main/DynFlags.hs-boot b/compiler/main/DynFlags.hs-boot index da54e49e66..04ec5a4e7d 100644 --- a/compiler/main/DynFlags.hs-boot +++ b/compiler/main/DynFlags.hs-boot @@ -9,3 +9,4 @@ targetPlatform :: DynFlags -> Platform pprUserLength :: DynFlags -> Int pprCols :: DynFlags -> Int unsafeGlobalDynFlags :: DynFlags +useUnicodeQuotes :: DynFlags -> Bool diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index 9e83634fab..f26f918068 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -72,6 +72,7 @@ module Outputable ( import {-# SOURCE #-} DynFlags( DynFlags, targetPlatform, pprUserLength, pprCols, + useUnicodeQuotes, unsafeGlobalDynFlags ) import {-# SOURCE #-} Module( Module, ModuleName, moduleName ) import {-# SOURCE #-} Name( Name, nameModule ) @@ -448,7 +449,11 @@ cparen b d = SDoc $ Pretty.cparen b . runSDoc d -- 'quotes' encloses something in single quotes... -- but it omits them if the thing begins or ends in a single quote -- so that we don't get `foo''. Instead we just have foo'. -quotes d = SDoc $ \sty -> +quotes d = + sdocWithDynFlags $ \dflags -> + if useUnicodeQuotes dflags + then char '‛' <> d <> char '’' + else SDoc $ \sty -> let pp_d = runSDoc d sty str = show pp_d in case (str, snocView str) of |