mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-19 12:56:08 +00:00
Merge branch 'bgamari-ghc-7.10-new'
This commit is contained in:
commit
8337a1db8e
@ -17,12 +17,6 @@ module Language.Haskell.GHC.Parser (
|
||||
parserTypeSignature,
|
||||
parserModule,
|
||||
parserExpression,
|
||||
partialStatement,
|
||||
partialImport,
|
||||
partialDeclaration,
|
||||
partialTypeSignature,
|
||||
partialModule,
|
||||
partialExpression,
|
||||
|
||||
-- Haskell string preprocessing.
|
||||
removeComments,
|
||||
@ -71,27 +65,20 @@ data Located a = Located {
|
||||
} deriving (Eq, Show, Functor)
|
||||
|
||||
|
||||
data ParserType = FullParser | PartialParser
|
||||
data Parser a = Parser ParserType (P a)
|
||||
data Parser a = Parser (P a)
|
||||
|
||||
-- Our parsers.
|
||||
parserStatement = Parser FullParser Parse.fullStatement
|
||||
parserImport = Parser FullParser Parse.fullImport
|
||||
parserDeclaration = Parser FullParser Parse.fullDeclaration
|
||||
parserExpression = Parser FullParser Parse.fullExpression
|
||||
parserTypeSignature = Parser FullParser Parse.fullTypeSignature
|
||||
parserModule = Parser FullParser Parse.fullModule
|
||||
partialStatement = Parser PartialParser Parse.partialStatement
|
||||
partialImport = Parser PartialParser Parse.partialImport
|
||||
partialDeclaration = Parser PartialParser Parse.partialDeclaration
|
||||
partialExpression = Parser PartialParser Parse.partialExpression
|
||||
partialTypeSignature = Parser PartialParser Parse.partialTypeSignature
|
||||
partialModule = Parser PartialParser Parse.partialModule
|
||||
parserStatement = Parser Parse.fullStatement
|
||||
parserImport = Parser Parse.fullImport
|
||||
parserDeclaration = Parser Parse.fullDeclaration
|
||||
parserExpression = Parser Parse.fullExpression
|
||||
parserTypeSignature = Parser Parse.fullTypeSignature
|
||||
parserModule = Parser Parse.fullModule
|
||||
|
||||
-- | Run a GHC parser on a string. Return success or failure with
|
||||
-- associated information for both.
|
||||
runParser :: DynFlags -> Parser a -> String -> ParseOutput a
|
||||
runParser flags (Parser parserType parser) str =
|
||||
runParser flags (Parser parser) str =
|
||||
-- Create an initial parser state.
|
||||
let filename = "<interactive>"
|
||||
location = mkRealSrcLoc (mkFastString filename) 1 1
|
||||
@ -115,10 +102,8 @@ runParser flags (Parser parserType parser) str =
|
||||
let parseEnd = realSrcSpanStart $ last_loc parseState
|
||||
endLine = srcLocLine parseEnd
|
||||
endCol = srcLocCol parseEnd
|
||||
(before, after) = splitAtLoc endLine endCol str in
|
||||
case parserType of
|
||||
PartialParser -> Partial result (before, after)
|
||||
FullParser -> Parsed result
|
||||
(before, after) = splitAtLoc endLine endCol str
|
||||
in Parsed result
|
||||
|
||||
-- Convert the bag of errors into an error string.
|
||||
printErrorBag bag = joinLines . map show $ bagToList bag
|
||||
|
@ -29,8 +29,8 @@ library
|
||||
Language.Haskell.GHC.HappyParser
|
||||
-- other-modules:
|
||||
-- other-extensions:
|
||||
build-depends: base >=4.6 && <4.8,
|
||||
ghc >=7.6 && <7.10
|
||||
build-depends: base >=4.6 && <4.9,
|
||||
ghc >=7.6 && <7.11
|
||||
|
||||
if impl(ghc >= 7.6) && impl(ghc < 7.8)
|
||||
hs-source-dirs: generic-src src-7.6
|
||||
@ -38,6 +38,9 @@ library
|
||||
if impl(ghc >= 7.8) && impl(ghc < 7.8.3)
|
||||
hs-source-dirs: generic-src src-7.8.2
|
||||
else
|
||||
hs-source-dirs: generic-src src-7.8.3
|
||||
if impl(ghc < 7.10)
|
||||
hs-source-dirs: generic-src src-7.8.3
|
||||
else
|
||||
hs-source-dirs: generic-src src-7.10
|
||||
|
||||
default-language: Haskell2010
|
||||
|
42
ghc-parser/src-7.10/Language/Haskell/GHC/HappyParser.hs
Normal file
42
ghc-parser/src-7.10/Language/Haskell/GHC/HappyParser.hs
Normal file
@ -0,0 +1,42 @@
|
||||
module Language.Haskell.GHC.HappyParser
|
||||
( fullStatement
|
||||
, fullImport
|
||||
, fullDeclaration
|
||||
, fullExpression
|
||||
, fullTypeSignature
|
||||
, fullModule
|
||||
) where
|
||||
|
||||
import Parser
|
||||
import SrcLoc
|
||||
|
||||
-- compiler/hsSyn
|
||||
import HsSyn
|
||||
|
||||
-- compiler/utils
|
||||
import OrdList
|
||||
|
||||
-- compiler/parser
|
||||
import RdrHsSyn
|
||||
import Lexer
|
||||
|
||||
-- compiler/basicTypes
|
||||
import RdrName
|
||||
|
||||
fullStatement :: P (Maybe (LStmt RdrName (LHsExpr RdrName)))
|
||||
fullStatement = parseStmt
|
||||
|
||||
fullImport :: P (LImportDecl RdrName)
|
||||
fullImport = parseImport
|
||||
|
||||
fullDeclaration :: P (OrdList (LHsDecl RdrName))
|
||||
fullDeclaration = parseDeclaration
|
||||
|
||||
fullExpression :: P (LHsExpr RdrName)
|
||||
fullExpression = parseExpression
|
||||
|
||||
fullTypeSignature :: P (Located (OrdList (LHsDecl RdrName)))
|
||||
fullTypeSignature = parseTypeSignature
|
||||
|
||||
fullModule :: P (Located (HsModule RdrName))
|
||||
fullModule = parseModule
|
@ -57,7 +57,7 @@ library
|
||||
OverloadedStrings
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base ==4.6.* || ==4.7.*,
|
||||
build-depends: base >=4.6 && <4.9,
|
||||
here,
|
||||
classy-prelude >=0.7,
|
||||
aeson >= 0.7,
|
||||
|
@ -61,7 +61,7 @@ library
|
||||
OverloadedStrings
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base ==4.6.* || ==4.7.*,
|
||||
build-depends: base >=4.6 && <4.9,
|
||||
classy-prelude >=0.6,
|
||||
ihaskell >= 0.5
|
||||
|
||||
|
@ -61,7 +61,7 @@ library
|
||||
OverloadedStrings
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base ==4.6.* || ==4.7.*,
|
||||
build-depends: base >=4.6 && <4.9,
|
||||
classy-prelude >=0.6,
|
||||
blaze-html >= 0.6,
|
||||
blaze-markup >= 0.5,
|
||||
|
@ -58,7 +58,7 @@ library
|
||||
OverloadedStrings
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base ==4.6.* || ==4.7.*,
|
||||
build-depends: base >=4.6 && <4.9,
|
||||
classy-prelude >=0.6,
|
||||
bytestring,
|
||||
data-default-class,
|
||||
|
@ -12,13 +12,13 @@ import Diagrams.Backend.Cairo
|
||||
|
||||
import IHaskell.Display
|
||||
|
||||
instance IHaskellDisplay (Diagram Cairo R2) where
|
||||
instance IHaskellDisplay (QDiagram Cairo V2 Double Any) where
|
||||
display renderable = do
|
||||
png <- diagramData renderable PNG
|
||||
svg <- diagramData renderable SVG
|
||||
return $ Display [png, svg]
|
||||
|
||||
diagramData :: Diagram Cairo R2 -> OutputType -> IO DisplayData
|
||||
diagramData :: Diagram Cairo -> OutputType -> IO DisplayData
|
||||
diagramData renderable format = do
|
||||
switchToTmpDir
|
||||
|
||||
@ -31,7 +31,7 @@ diagramData renderable format = do
|
||||
|
||||
-- Write the image.
|
||||
let filename = ".ihaskell-diagram." ++ extension format
|
||||
renderCairo filename (Height imgHeight) renderable
|
||||
renderCairo filename (mkHeight imgHeight) renderable
|
||||
|
||||
-- Convert to base64.
|
||||
imgData <- readFile $ fpFromString filename
|
||||
@ -45,5 +45,5 @@ diagramData renderable format = do
|
||||
extension PNG = "png"
|
||||
|
||||
-- Rendering hint.
|
||||
diagram :: Diagram Cairo R2 -> Diagram Cairo R2
|
||||
diagram :: Diagram Cairo -> Diagram Cairo
|
||||
diagram = id
|
||||
|
@ -58,7 +58,7 @@ library
|
||||
OverloadedStrings
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base ==4.6.* || ==4.7.*,
|
||||
build-depends: base >=4.6 && <4.9,
|
||||
classy-prelude >=0.6,
|
||||
bytestring,
|
||||
directory,
|
||||
|
@ -14,7 +14,7 @@ cabal-version: >=1.16
|
||||
|
||||
library
|
||||
exposed-modules: IHaskell.Display.Hatex
|
||||
build-depends: base ==4.6.* || ==4.7.*,
|
||||
build-depends: base >=4.6 && <4.9,
|
||||
text,
|
||||
HaTeX >= 3.9,
|
||||
ihaskell >= 0.5
|
||||
|
@ -62,7 +62,7 @@ library
|
||||
OverloadedStrings
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base ==4.6.* || ==4.7.*,
|
||||
build-depends: base >=4.6 && <4.9,
|
||||
classy-prelude >=0.6,
|
||||
bytestring,
|
||||
directory,
|
||||
|
@ -61,7 +61,7 @@ library
|
||||
OverloadedStrings
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base ==4.6.* || ==4.7.*,
|
||||
build-depends: base >=4.6 && <4.9,
|
||||
classy-prelude >=0.6,
|
||||
magic >= 1.0.8,
|
||||
text,
|
||||
|
@ -58,7 +58,7 @@ library
|
||||
OverloadedStrings
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base ==4.6.* || ==4.7.*,
|
||||
build-depends: base >=4.6 && <4.9,
|
||||
aeson >=0.7 && <0.9,
|
||||
unordered-containers,
|
||||
classy-prelude,
|
||||
|
@ -58,7 +58,7 @@ library
|
||||
OverloadedStrings
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base ==4.6.* || ==4.7.*,
|
||||
build-depends: base >=4.6 && <4.9,
|
||||
aeson >=0.7 && <0.9,
|
||||
classy-prelude,
|
||||
here,
|
||||
|
@ -48,12 +48,16 @@ data-files:
|
||||
installation/run.sh
|
||||
profile/profile.tar
|
||||
|
||||
flag binPkgDb
|
||||
default: True
|
||||
description: bin-package-db package needed (needed for GHC >= 7.10)
|
||||
|
||||
library
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
build-depends:
|
||||
aeson >=0.6 && < 0.9,
|
||||
base >=4.6 && < 4.8,
|
||||
base >=4.6 && < 4.9,
|
||||
base64-bytestring >=1.0,
|
||||
bytestring >=0.10,
|
||||
cereal >=0.3,
|
||||
@ -63,7 +67,7 @@ library
|
||||
containers >=0.5,
|
||||
directory -any,
|
||||
filepath -any,
|
||||
ghc ==7.6.* || == 7.8.*,
|
||||
ghc >=7.6 || < 7.11,
|
||||
ghc-parser >=0.1.4,
|
||||
haskeline -any,
|
||||
here ==1.2.*,
|
||||
@ -95,6 +99,8 @@ library
|
||||
ipython-kernel >=0.3,
|
||||
arithmoi ==0.4.*
|
||||
-- arithmoi is fixed to avoid issues with diagrams
|
||||
if flag(binPkgDb)
|
||||
build-depends: bin-package-db
|
||||
|
||||
exposed-modules: IHaskell.Display
|
||||
IHaskell.Convert
|
||||
@ -127,7 +133,7 @@ executable IHaskell
|
||||
-- Other library packages from which modules are imported.
|
||||
default-language: Haskell2010
|
||||
build-depends:
|
||||
base >=4.6 && < 4.8,
|
||||
base >=4.6 && < 4.9,
|
||||
ghc-paths ==0.1.*,
|
||||
aeson >=0.6 && < 0.9,
|
||||
bytestring >=0.10,
|
||||
@ -136,12 +142,14 @@ executable IHaskell
|
||||
mono-traversable >=0.6,
|
||||
containers >=0.5,
|
||||
directory -any,
|
||||
ghc ==7.6.* || == 7.8.*,
|
||||
ghc >=7.6 && < 7.11,
|
||||
ihaskell -any,
|
||||
MissingH >=1.2,
|
||||
text -any,
|
||||
ipython-kernel >= 0.2,
|
||||
unix >= 2.6
|
||||
if flag(binPkgDb)
|
||||
build-depends: bin-package-db
|
||||
|
||||
Test-Suite hspec
|
||||
hs-source-dirs: src
|
||||
@ -151,7 +159,7 @@ Test-Suite hspec
|
||||
default-language: Haskell2010
|
||||
build-depends:
|
||||
aeson >=0.6 && < 0.9,
|
||||
base >=4.6 && < 4.8,
|
||||
base >=4.6 && < 4.9,
|
||||
base64-bytestring >=1.0,
|
||||
bytestring >=0.10,
|
||||
cereal >=0.3,
|
||||
@ -161,7 +169,7 @@ Test-Suite hspec
|
||||
containers >=0.5,
|
||||
directory -any,
|
||||
filepath -any,
|
||||
ghc ==7.6.* || == 7.8.*,
|
||||
ghc >=7.6 && < 7.11,
|
||||
ghc-parser >=0.1.1,
|
||||
ghc-paths ==0.1.*,
|
||||
haskeline -any,
|
||||
@ -193,7 +201,8 @@ Test-Suite hspec
|
||||
vector -any,
|
||||
setenv ==0.1.*,
|
||||
ipython-kernel >= 0.2
|
||||
|
||||
if flag(binPkgDb)
|
||||
build-depends: bin-package-db
|
||||
|
||||
default-extensions:
|
||||
DoAndIfThenElse
|
||||
|
@ -36,7 +36,7 @@ library
|
||||
other-extensions: OverloadedStrings
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
build-depends: base >=4.6 && < 4.8,
|
||||
build-depends: base >=4.6 && < 4.9,
|
||||
aeson >=0.6 && < 0.9,
|
||||
bytestring >=0.10,
|
||||
cereal >=0.3,
|
||||
@ -57,7 +57,7 @@ executable simple-calc-example
|
||||
hs-source-dirs: examples
|
||||
main-is: Calc.hs
|
||||
build-depends: ipython-kernel,
|
||||
base >=4.6 && <4.8,
|
||||
base >=4.6 && <4.9,
|
||||
filepath >=1.2,
|
||||
mtl >=2.1,
|
||||
parsec >=3.1,
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings, NoImplicitPrelude, FlexibleContexts #-}
|
||||
module IHaskell.BrokenPackages (getBrokenPackages) where
|
||||
|
||||
import ClassyPrelude hiding ((<|>))
|
||||
|
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, DoAndIfThenElse #-}
|
||||
{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings, DoAndIfThenElse #-}
|
||||
{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
|
||||
{- |
|
||||
Description: Generates tab completion options.
|
||||
|
||||
@ -25,7 +26,10 @@ import Data.String.Utils (strip, startswith, endswith, replace)
|
||||
import qualified Data.String.Utils as StringUtils
|
||||
import System.Environment (getEnv)
|
||||
|
||||
import GHC
|
||||
import GHC hiding (Qualified)
|
||||
#if MIN_VERSION_ghc(7,10,0)
|
||||
import GHC.PackageDb (ExposedModule(exposedName))
|
||||
#endif
|
||||
import DynFlags
|
||||
import GhcMonad
|
||||
import PackageConfig
|
||||
@ -64,8 +68,12 @@ complete line pos = do
|
||||
unqualNames = nub $ filter (not . isQualified) rdrNames
|
||||
qualNames = nub $ scopeNames ++ filter isQualified rdrNames
|
||||
|
||||
#if !MIN_VERSION_ghc(7,10,0)
|
||||
let exposedName = id
|
||||
#endif
|
||||
|
||||
let Just db = pkgDatabase flags
|
||||
getNames = map moduleNameString . exposedModules
|
||||
getNames = map (moduleNameString . exposedName) . exposedModules
|
||||
moduleNames = nub $ concatMap getNames db
|
||||
|
||||
let target = completionTarget line pos
|
||||
@ -76,6 +84,12 @@ complete line pos = do
|
||||
FilePath _ match -> match
|
||||
otherwise -> intercalate "." target
|
||||
|
||||
#if MIN_VERSION_ghc(7,10,0)
|
||||
let extName (FlagSpec {flagSpecName=name}) = name
|
||||
#else
|
||||
let extName (name, _, _) = name
|
||||
#endif
|
||||
|
||||
options <-
|
||||
case completion of
|
||||
Empty -> return []
|
||||
@ -100,9 +114,7 @@ complete line pos = do
|
||||
-- Possibly leave out the fLangFlags? The
|
||||
-- -XUndecidableInstances vs. obsolete
|
||||
-- -fallow-undecidable-instances.
|
||||
let extName (name, _, _) = name
|
||||
|
||||
kernelOptNames = concatMap getSetName kernelOpts
|
||||
let kernelOptNames = concatMap getSetName kernelOpts
|
||||
otherNames = ["-package","-Wall","-w"]
|
||||
|
||||
fNames = map extName fFlags ++
|
||||
@ -120,8 +132,7 @@ complete line pos = do
|
||||
return $ filter (ext `isPrefixOf`) allNames
|
||||
|
||||
Extension ext -> do
|
||||
let extName (name, _, _) = name
|
||||
xNames = map extName xFlags
|
||||
let xNames = map extName xFlags
|
||||
xNoNames = map ("No" ++) xNames
|
||||
return $ filter (ext `isPrefixOf`) $ xNames ++ xNoNames
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE DoAndIfThenElse, NoOverloadedStrings, TypeSynonymInstances, CPP #-}
|
||||
{-# LANGUAGE DoAndIfThenElse, NoOverloadedStrings, TypeSynonymInstances, GADTs, CPP #-}
|
||||
|
||||
{- | Description : Wrapper around GHC API, exposing a single `evaluate` interface that runs
|
||||
a statement, declaration, import, or directive.
|
||||
@ -22,7 +22,10 @@ import Data.Typeable
|
||||
import qualified Data.Serialize as Serialize
|
||||
import System.Directory
|
||||
import Filesystem.Path.CurrentOS (encodeString)
|
||||
import System.Posix.IO
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import System.Posix.IO (createPipe)
|
||||
#endif
|
||||
import System.Posix.IO (fdToHandle)
|
||||
import System.IO (hGetChar, hFlush)
|
||||
import System.Random (getStdGen, randomRs)
|
||||
import Unsafe.Coerce
|
||||
@ -53,7 +56,7 @@ import GHC hiding (Stmt, TypeSig)
|
||||
import Exception hiding (evaluate)
|
||||
import Outputable hiding ((<>))
|
||||
import Packages
|
||||
import Module
|
||||
import Module hiding (Module)
|
||||
import qualified Pretty
|
||||
import FastString
|
||||
import Bag
|
||||
@ -157,6 +160,9 @@ initializeImports = do
|
||||
displayPackages <- liftIO $ do
|
||||
(dflags, _) <- initPackages dflags
|
||||
let Just db = pkgDatabase dflags
|
||||
#if MIN_VERSION_ghc(7,10,0)
|
||||
packageIdString = packageKeyPackageIdString dflags
|
||||
#endif
|
||||
packageNames = map (packageIdString . packageConfigId) db
|
||||
|
||||
initStr = "ihaskell-"
|
||||
@ -568,9 +574,13 @@ evalCommand publish (Directive ShellCmd ('!':cmd)) state = wrapExecution state $
|
||||
else
|
||||
return $ displayError $ printf "No such directory: '%s'" directory
|
||||
cmd -> liftIO $ do
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
(pipe, handle) <- createPipe
|
||||
#else
|
||||
(readEnd, writeEnd) <- createPipe
|
||||
handle <- fdToHandle writeEnd
|
||||
pipe <- fdToHandle readEnd
|
||||
#endif
|
||||
let initProcSpec = shell $ unwords cmd
|
||||
procSpec = initProcSpec {
|
||||
std_in = Inherit,
|
||||
|
@ -73,8 +73,8 @@ parseString codeString = do
|
||||
flags <- getSessionDynFlags
|
||||
let output = runParser flags parserModule codeString
|
||||
case output of
|
||||
Parsed {} -> return [Located 1 $ Module codeString]
|
||||
Failure {} -> do
|
||||
Parsed mod | Just _ <- hsmodName (unLoc mod) -> return [Located 1 $ Module codeString]
|
||||
_ -> do
|
||||
-- Split input into chunks based on indentation.
|
||||
let chunks = layoutChunks $ removeComments codeString
|
||||
result <- joinFunctions <$> processChunks [] chunks
|
||||
|
@ -61,21 +61,25 @@ extensionFlag :: String -- Extension name, such as @"DataKinds"@
|
||||
-> Maybe ExtFlag
|
||||
extensionFlag ext =
|
||||
case find (flagMatches ext) xFlags of
|
||||
Just (_, flag, _) -> Just $ SetFlag flag
|
||||
Just fs -> Just $ SetFlag $ flagSpecFlag fs
|
||||
-- If it doesn't match an extension name, try matching against
|
||||
-- disabling an extension.
|
||||
Nothing ->
|
||||
case find (flagMatchesNo ext) xFlags of
|
||||
Just (_, flag, _) -> Just $ UnsetFlag flag
|
||||
Just fs -> Just $ UnsetFlag $ flagSpecFlag fs
|
||||
Nothing -> Nothing
|
||||
|
||||
where
|
||||
-- Check if a FlagSpec matches an extension name.
|
||||
flagMatches ext (name, _, _) = ext == name
|
||||
flagMatches ext fs = ext == flagSpecName fs
|
||||
|
||||
-- Check if a FlagSpec matches "No<ExtensionName>".
|
||||
-- In that case, we disable the extension.
|
||||
flagMatchesNo ext (name, _, _) = ext == "No" ++ name
|
||||
flagMatchesNo ext fs = ext == "No" ++ flagSpecName fs
|
||||
|
||||
#if !MIN_VERSION_ghc(7,10,0)
|
||||
flagSpecName (name,_,_) = name
|
||||
flagSpecFlag (_,flag,_) = flag
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_ghc(7,10,0)
|
||||
flagSpecName (name,_,_) = name
|
||||
|
Loading…
x
Reference in New Issue
Block a user