summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/main/DynFlags.hs15
-rw-r--r--compiler/main/DynFlags.hs-boot1
-rw-r--r--compiler/utils/Outputable.lhs7
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