mirrors/IHaskell
1
0
Fork 0
mirror of https://github.com/IHaskell/IHaskell.git synced 2025-04-16 11:26:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Updated some things to 7.8, not yet compiling.

Browse Source
This commit is contained in:
Andrew Gibiansky 2014-06-08 11:06:31 -07:00
parent 371fcfcafe
commit 9c6490bf9f
10 changed files with 32088 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
ghc-parser/HaskellParser.y.pp → ghc-parser/HaskellParser76.y.pp
View File

@ -394,20 +394,6 @@ namedModule :: { Located (HsModule RdrName) }
return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4 $1
) )}
{-
fundecl :: { OrdList (LHsDecl RdrName) }
: sigdecl ';' funcs { unLoc $1 `appOL` $3 }
| funcs { $1 }
funcs :: { OrdList (LHsDecl RdrName) }
: func ';' funcs { unLoc $1 `appOL` $3 }
| func { unLoc $1 }
func :: { Located (OrdList (LHsDecl RdrName)) }
func : fexp opt_sig rhs {% do { r <- checkValDef $1 $2 $3;
let { l = comb2 $1 $> };
return $! (sL l (unitOL $! (sL l $ ValD r))) } }
-}
-----------------------------------------------------------------------------
-- Identifiers; one of the entry points
identifier :: { Located RdrName }

2340
ghc-parser/HaskellParser78.y.pp Normal file
View File

File diff suppressed because it is too large Load Diff

26
ghc-parser/build-parser.sh
View File

@ -1,13 +1,21 @@
#!/bin/sh
#!/bin/sh -e
# Called from Setup.hs.
# Preprocess the GHC parser we're using to CPP subs.
cpphs --linepragma --text HaskellParser.y.pp -OParser.y
function make_parser {
SRCDIR=$1
SRCNAME=$2
# Compile the parser and remove intermediate file.
happy Parser.y
rm Parser.y
# Preprocess the GHC parser we're using to CPP subs.
cpphs --linepragma --text ${SRCNAME}.y.pp -OParser.y
# Move output Haskell to source directory.
mkdir -p Language/Haskell/GHC
mv Parser.hs Language/Haskell/GHC/HappyParser.hs
# Compile the parser and remove intermediate file.
happy Parser.y
rm Parser.y
# Move output Haskell to source directory.
mkdir -p $SRCDIR/Language/Haskell/GHC
mv Parser.hs $SRCDIR/Language/Haskell/GHC/HappyParser.hs
}
make_parser src-7.6 HaskellParser76
make_parser src-7.8 HaskellParser78

0
ghc-parser/Language/Haskell/GHC/Parser.hs → ghc-parser/generic-src/Language/Haskell/GHC/Parser.hs
View File

17
ghc-parser/ghc-parser.cabal
View File

@ -2,7 +2,7 @@
-- documentation, see http://haskell.org/cabal/users-guide/
name: ghc-parser
version: 0.1.1.0
version: 0.1.2.0
synopsis: Haskell source parser from GHC.
-- description:
homepage: https://github.com/gibiansky/IHaskell
@ -18,15 +18,20 @@ cabal-version: >=1.16
extra-source-files:
build-parser.sh
HaskellParser.y.pp
HaskellParser76.y.pp
HaskellParser78.y.pp
library
exposed-modules: Language.Haskell.GHC.Parser,
Language.Haskell.GHC.HappyParser
-- other-modules:
-- other-extensions:
build-depends: base >=4.6 && <4.7,
ghc ==7.6.*
-- hs-source-dirs:
default-language: Haskell2010
build-depends: base >=4.6 && <4.8,
ghc >=7.6 && <7.10
if impl(ghc >= 7.6) && impl(ghc < 7.8)
hs-source-dirs: generic-src src-7.6
else
hs-source-dirs: generic-src src-7.8
default-language: Haskell2010

34
ghc-parser/Language/Haskell/GHC/HappyParser.hs → ghc-parser/src-7.6/Language/Haskell/GHC/HappyParser.hs
View File

@ -26665,12 +26665,13 @@ hintMultiWayIf span = do
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "<built-in>" #-}
{-# LINE 1 "<command-line>" #-}
{-# LINE 1 "templates/GenericTemplate.hs" #-}
-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp
{-# LINE 13 "templates/GenericTemplate.hs" #-}
{-# LINE 46 "templates/GenericTemplate.hs" #-}
@ -26680,11 +26681,20 @@ hintMultiWayIf span = do
{-# LINE 67 "templates/GenericTemplate.hs" #-}
{-# LINE 77 "templates/GenericTemplate.hs" #-}
{-# LINE 86 "templates/GenericTemplate.hs" #-}
infixr 9 `HappyStk`
data HappyStk a = HappyStk a (HappyStk a)
@ -26708,6 +26718,7 @@ happyAccept j tk st sts (HappyStk ans _) =
-----------------------------------------------------------------------------
-- Arrays only: do the next action
{-# LINE 155 "templates/GenericTemplate.hs" #-}
-----------------------------------------------------------------------------
@ -26802,7 +26813,14 @@ happyDropStk n (x `HappyStk` xs) = happyDropStk (n - ((1)::Int)) xs
-----------------------------------------------------------------------------
-- Moving to a new state after a reduction
{-# LINE 256 "templates/GenericTemplate.hs" #-}
happyGoto action j tk st = action j j tk (HappyState action)
@ -26861,7 +26879,14 @@ happyDontSeq a b = b
-- of deciding to inline happyGoto everywhere, which increases the size of
-- the generated parser quite a bit.
{-# LINE 322 "templates/GenericTemplate.hs" #-}
{-# NOINLINE happyShift #-}
{-# NOINLINE happySpecReduce_0 #-}
{-# NOINLINE happySpecReduce_1 #-}
@ -26873,3 +26898,4 @@ happyDontSeq a b = b
{-# NOINLINE happyFail #-}
-- end of Happy Template.

29625
ghc-parser/src-7.8/Language/Haskell/GHC/HappyParser.hs Normal file
View File

File diff suppressed because it is too large Load Diff

14
ihaskell.cabal
View File

@ -54,7 +54,7 @@ library
ghc-options: -threaded
build-depends:
aeson >=0.6 && < 0.8,
base ==4.6.*,
base >=4.6 && < 4.8,
base64-bytestring >=1.0,
bytestring >=0.10,
cereal >=0.3,
@ -64,8 +64,8 @@ library
containers >=0.5,
directory -any,
filepath -any,
ghc ==7.6.*,
ghc-parser >=0.1.1,
ghc ==7.6.* || == 7.8.*,
ghc-parser >=0.1.2,
ghc-paths ==0.1.*,
haskeline -any,
here ==1.2.*,
@ -133,7 +133,7 @@ executable IHaskell
-- Other library packages from which modules are imported.
default-language: Haskell2010
build-depends:
base ==4.6.*,
base >=4.6 && < 4.8,
aeson >=0.6 && < 0.8,
bytestring >=0.10,
cereal >=0.3,
@ -141,7 +141,7 @@ executable IHaskell
mono-traversable ==0.6.0,
containers >=0.5,
directory -any,
ghc ==7.6.*,
ghc ==7.6.* || == 7.8.*,
ihaskell -any,
MissingH >=1.2,
text -any,
@ -155,7 +155,7 @@ Test-Suite hspec
default-language: Haskell2010
build-depends:
aeson >=0.6 && < 0.8,
base ==4.6.*,
base >=4.6 && < 4.8,
base64-bytestring >=1.0,
bytestring >=0.10,
cereal >=0.3,
@ -165,7 +165,7 @@ Test-Suite hspec
containers >=0.5,
directory -any,
filepath -any,
ghc ==7.6.*,
ghc ==7.6.* || == 7.8.*,
ghc-parser >=0.1.1,
ghc-paths ==0.1.*,
haskeline -any,

30
src/IHaskell/Eval/Evaluate.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE DoAndIfThenElse, NoOverloadedStrings, TypeSynonymInstances #-}
{-# LANGUAGE DoAndIfThenElse, NoOverloadedStrings, TypeSynonymInstances, CPP #-}
{- | Description : Wrapper around GHC API, exposing a single `evaluate` interface that runs
a statement, declaration, import, or directive.
@ -96,8 +96,12 @@ write x = when debug $ liftIO $ hPutStrLn stderr $ "DEBUG: " ++ x
type Interpreter = Ghc
#if MIN_VERSION_ghc(7, 8, 0)
-- GHC 7.8 exports a MonadIO instance for Ghc
#else
instance MonadIO.MonadIO Interpreter where
liftIO = MonadUtils.liftIO
#endif
globalImports :: [String]
globalImports =
@ -618,30 +622,8 @@ evalCommand _ (Directive GetHelp _) state = do
evalCommand _ (Directive GetInfo str) state = safely state $ do
write $ "Info: " ++ str
-- Get all the info for all the names we're given.
names <- parseName str
maybeInfos <- mapM getInfo names
strings <- getDescription str
-- Filter out types that have parents in the same set.
-- GHCi also does this.
let getType (theType, _, _) = theType
infos = catMaybes maybeInfos
allNames = mkNameSet $ map (getName . getType) infos
hasParent info = case tyThingParent_maybe (getType info) of
Just parent -> getName parent `elemNameSet` allNames
Nothing -> False
filteredOutput = filter (not . hasParent) infos
-- Convert to textual data.
let printInfo (thing, fixity, classInstances) =
pprTyThingInContextLoc False thing $$ showFixity fixity $$ vcat (map GHC.pprInstance classInstances)
where
showFixity fixity =
if fixity == GHC.defaultFixity
then empty
else ppr fixity <+> pprInfixName (getName thing)
-- Print nicely.
strings <- mapM (doc . printInfo) filteredOutput
let output = case getFrontend state of
IPythonConsole -> unlines strings
IPythonNotebook -> unlines (map htmlify strings)

53
src/IHaskell/Eval/Util.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP, NoImplicitPrelude #-}
module IHaskell.Eval.Util (
-- * Initialization
initGhci,
@ -12,11 +13,14 @@ module IHaskell.Eval.Util (
evalImport,
evalDeclarations,
getType,
getDescription,
-- * Pretty printing
doc,
) where
import ClassyPrelude
-- GHC imports.
import DynFlags
import FastString
@ -29,11 +33,13 @@ import Module
import Outputable
import Packages
import RdrName
import NameSet
import Name
import PprTyThing
import qualified Pretty
import Control.Monad (void)
import Data.Function (on)
import Data.List (find)
import Data.String.Utils (replace)
-- | A extension flag that can be set or unset.
@ -190,3 +196,48 @@ getType expr = do
flags <- getSessionDynFlags
let typeStr = showSDocUnqual flags $ ppr result
return typeStr
-- | A wrapper around @getInfo@. Return info about each name in the string.
getDescription :: GhcMonad m => String -> m [String]
getDescription str = do
names <- parseName str
maybeInfos <- mapM getInfo' names
-- Filter out types that have parents in the same set.
-- GHCi also does this.
let infos = catMaybes maybeInfos
allNames = mkNameSet $ map (getName . getType) infos
hasParent info = case tyThingParent_maybe (getType info) of
Just parent -> getName parent `elemNameSet` allNames
Nothing -> False
filteredOutput = filter (not . hasParent) infos
-- Print nicely
mapM (doc . printInfo) filteredOutput
where
#if MIN_VERSION_ghc(7,8,0)
getInfo' = getInfo False
#else
getInfo' = getInfo
#endif
#if MIN_VERSION_ghc(7,8,0)
getType (theType, _, _, _) = theType
#else
getType (theType, _, _) = theType
#endif
#if MIN_VERSION_ghc(7,8,0)
printInfo (thing, fixity, classInstances, famInstances) =
pprTyThingInContextLoc thing $$
showFixity thing fixity $$
vcat (map GHC.pprInstance classInstances) $$
vcat (map GHC.pprFamInst famInstances)
#else
printInfo (thing, fixity, classInstances) =
pprTyThingInContextLoc False thing $$ showFixity thing fixity $$ vcat (map GHC.pprInstance classInstances)
#endif
showFixity thing fixity =
if fixity == GHC.defaultFixity
then empty
else ppr fixity <+> pprInfixName (getName thing)