Cheng Shao pushed to branch wip/no-binary-char-2 at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • compiler/GHC/Data/FastString.hs
    ... ... @@ -55,6 +55,7 @@ module GHC.Data.FastString
    55 55
    56 56 
             -- * ShortByteString
    57 57 
             fastStringToShortByteString,
    58 
    +        fastStringToOsPath,
    58 59 
             mkFastStringShortByteString,
    59 60
    60 61 
             -- * ShortText
    ... ... @@ -142,6 +143,7 @@ import System.IO
    142 143 
     import Data.Data
    143 144 
     import Data.IORef
    144 145 
     import Data.Semigroup as Semi
    146 
    +import Data.Type.Coercion (coerceWith, sym)
    145 147
    146 148 
     import Foreign
    147 149
    ... ... @@ -149,6 +151,12 @@ import GHC.Conc.Sync (sharedCAF)
    149 151
    150 152 
     import GHC.Exts
    151 153 
     import GHC.IO
    154 
    +import System.OsString.Internal.Types
    155 
    +  ( PosixString(..)
    156 
    +  , WindowsString(..)
    157 
    +  , coercionToPlatformTypes
    158 
    +  )
    159 
    +import System.OsPath (OsPath)
    152 160
    153 161 
     -- | Gives the Modified UTF-8 encoded bytes corresponding to a 'FastString'
    154 162 
     bytesFS, fastStringToByteString :: FastString -> ByteString
    ... ... @@ -161,6 +169,14 @@ fastStringToByteString = bytesFS
    161 169 
     fastStringToShortByteString :: FastString -> ShortByteString
    162 170 
     fastStringToShortByteString = fs_sbs
    163 171
    172 
    +fastStringToOsPath :: FastString -> OsPath
    173 
    +fastStringToOsPath fs =
    174 
    +  case coercionToPlatformTypes of
    175 
    +    Left (_cChar, cStr) ->
    176 
    +      coerceWith (sym cStr) (WindowsString (fastStringToShortByteString fs))
    177 
    +    Right (_cChar, cStr) ->
    178 
    +      coerceWith (sym cStr) (PosixString (fastStringToShortByteString fs))
    179 
    +
    164 180 
     fastStringToShortText :: FastString -> ShortText
    165 181 
     fastStringToShortText = ShortText . fs_sbs
    166 182

  • compiler/GHC/Iface/Recomp.hs
    ... ... @@ -53,7 +53,7 @@ import GHC.Utils.Exception
    53 53 
     import GHC.Utils.Logger
    54 54 
     import GHC.Utils.Constants (debugIsOn)
    55 55 
     import qualified GHC.Data.ShortText as ST
    56 
    -import GHC.Data.OsPath (unsafeDecodeUtf)
    56 
    +import GHC.Data.OsPath (OsPath, unsafeDecodeUtf)
    57 57
    58 58 
     import GHC.Types.Annotations
    59 59 
     import GHC.Types.Avail
    ... ... @@ -195,9 +195,9 @@ data RecompReason
    195 195 
       | ModuleAdded (ImportLevel, UnitId, ModuleName)
    196 196 
       | ModuleChangedRaw ModuleName
    197 197 
       | ModuleChangedIface ModuleName
    198 
    -  | FileChanged FilePath
    199 
    -  | DirChanged FilePath
    200 
    -  | CustomReason String
    198 
    +  | FileChanged !OsPath
    199 
    +  | DirChanged !OsPath
    200 
    +  | CustomReason !ST.ShortText
    201 201 
       | FlagsChanged
    202 202 
       | LinkFlagsChanged
    203 203 
       | OptimFlagsChanged
    ... ... @@ -232,9 +232,9 @@ instance Outputable RecompReason where
    232 232 
         ModuleChangedIface m     -> ppr m <+> text "changed (interface)"
    233 233 
         ModuleRemoved (_st, _uid, m)   -> ppr m <+> text "removed"
    234 234 
         ModuleAdded (_st, _uid, m)     -> ppr m <+> text "added"
    235 
    -    FileChanged fp           -> text fp <+> text "changed"
    236 
    -    DirChanged dp            -> text "Contents of" <+> text dp <+> text "changed"
    237 
    -    CustomReason s           -> text s
    235 
    +    FileChanged fp           -> text (unsafeDecodeUtf fp) <+> text "changed"
    236 
    +    DirChanged dp            -> text "Contents of" <+> text (unsafeDecodeUtf dp) <+> text "changed"
    237 
    +    CustomReason s           -> text (ST.unpack s)
    238 238 
         FlagsChanged             -> text "Flags changed"
    239 239 
         LinkFlagsChanged         -> text "Flags changed"
    240 240 
         OptimFlagsChanged        -> text "Optimisation flags changed"
    ... ... @@ -812,10 +812,11 @@ checkModUsage fc UsageFile{ usg_file_path = file,
    812 812 
           if (old_hash /= new_hash)
    813 813 
              then return recomp
    814 814 
              else return UpToDate
    815 
    - where
    816 
    -   reason = FileChanged $ unpackFS file
    817 
    -   recomp  = needsRecompileBecause $ fromMaybe reason $ fmap (CustomReason . ST.unpack) mlabel
    818 
    -   handler = if debugIsOn
    815 
    +  where
    816 
    +    pathOs = fastStringToOsPath file
    817 
    +    reason = FileChanged pathOs
    818 
    +    recomp = needsRecompileBecause $ fromMaybe reason (CustomReason <$> mlabel)
    819 
    +    handler = if debugIsOn
    819 820 
           then \e -> pprTrace "UsageFile" (text (show e)) $ return recomp
    820 821 
           else \_ -> return recomp -- if we can't find the file, just recompile, don't fail
    821 822
    ... ... @@ -828,10 +829,11 @@ checkModUsage fc UsageDirectory{ usg_dir_path = dir,
    828 829 
           if (old_hash /= new_hash)
    829 830 
              then return recomp
    830 831 
              else return UpToDate
    831 
    - where
    832 
    -   reason  = DirChanged $ unpackFS dir
    833 
    -   recomp  = needsRecompileBecause $ fromMaybe reason $ fmap (CustomReason . ST.unpack) mlabel
    834 
    -   handler = if debugIsOn
    832 
    +  where
    833 
    +    dirOs = fastStringToOsPath dir
    834 
    +    reason  = DirChanged dirOs
    835 
    +    recomp  = needsRecompileBecause $ fromMaybe reason (CustomReason <$> mlabel)
    836 
    +    handler = if debugIsOn
    835 837 
           then \e -> pprTrace "UsageDirectory" (text (show e)) $ return recomp
    836 838 
           else \_ -> return recomp -- if we can't find the dir, just recompile, don't fail
    837 839

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help