Skip to content

G
gargantext-ihaskell
Commit 3d759239 authored by Andrew Gibiansky's avatar Andrew Gibiansky
Browse files
Options

added things to ghci-lib

parent 86db7eff
Hide whitespace changes
Inline Side-by-side
Showing with 82 additions and 79 deletions
build.sh
View file @ 3d759239
......@@ -32,7 +32,7 @@ cabal install --force-reinstalls
rm -rf ~/.ipython/profile_haskell
if [ $# -gt 0 ]; then
if [ $1 = "all" ]; then
if [ $1 = "display" ]; then
# Install all the display libraries
cd ihaskell-display
for dir in `ls`
......
ghci-lib/Language/Haskell/GHC/Interpret.hs
View file @ 3d759239
......@@ -8,11 +8,10 @@ module Language.Haskell.GHC.Interpret (
evalExpression,
-}
evalImport,
{-
evalDeclarations,
setExtension,
setFlag,
setFlags,
getType,
{-
loadFile,
-}
) where
......@@ -24,10 +23,13 @@ import GhcMonad
import HsImpExp
import HscTypes
import RdrName
import Outputable
import Data.Function (on)
import Control.Monad (void)
import Data.String.Utils (replace)
-- | Initialize the GHC API. Run this as the first thing in the `runGhc`.
initGhci :: GhcMonad m => m ()
initGhci = do
......@@ -42,6 +44,10 @@ initGhci = do
ghcLink = LinkInMemory,
pprCols = 300 }
-- | Evaluate a single import statement.
-- If this import statement is importing a module which was previously
-- imported implicitly (such as `Prelude`) or if this module has a `hiding`
-- annotation, the previous import is removed.
evalImport :: GhcMonad m => String -> m ()
evalImport imports = do
importDecl <- parseImportDecl imports
......@@ -74,3 +80,41 @@ evalImport imports = do
isHiddenImport imp = case ideclHiding imp of
Just (True, _) -> True
_ -> False
-- | Evaluate a series of declarations.
-- Return all names which were bound by these declarations.
evalDeclarations :: GhcMonad m => String -> m [String]
evalDeclarations decl = do
names <- runDecls decl
flags <- getSessionDynFlags
return $ map (replace ":Interactive." "" . showPpr flags) names
-- | Set a list of flags, as per GHCi's `:set`.
-- This was adapted from GHC's InteractiveUI.hs (newDynFlags).
-- It returns a list of error messages.
setFlags :: GhcMonad m => [String] -> m [String]
setFlags ext = do
-- Try to parse flags.
flags <- getSessionDynFlags
(flags', unrecognized, warnings) <- parseDynamicFlags flags (map noLoc ext)
-- First, try to check if this flag matches any extension name.
let restorePkg x = x { packageFlags = packageFlags flags }
let restoredPkgs = flags' { packageFlags = packageFlags flags}
GHC.setProgramDynFlags restoredPkgs
GHC.setInteractiveDynFlags restoredPkgs
-- Create the parse errors.
let noParseErrs = map (("Could not parse: " ++) . unLoc) unrecognized
allWarns = map unLoc warnings ++
["-package not supported yet" | packageFlags flags /= packageFlags flags']
warnErrs = map ("Warning: " ++) allWarns
return $ noParseErrs ++ warnErrs
-- | Get the type of an expression.
getType :: GhcMonad m => String -> m String
getType expr = do
result <- exprType expr
flags <- getSessionDynFlags
let typeStr = showSDocUnqual flags $ ppr result
return typeStr
ghci-lib/ghci-lib.cabal
View file @ 3d759239
......@@ -17,10 +17,12 @@ build-type: Simple
cabal-version: >=1.10
library
exposed-modules: Language.Haskell.GHC.Interpret
exposed-modules: Language.Haskell.GHC.Interpret,
Language.Haskell.GHC.Util
-- other-modules:
-- other-extensions:
build-depends: base >=4.6 && <4.7,
ghc==7.6.*
ghc==7.6.*, MissingH >= 1.2
-- hs-source-dirs:
default-language: Haskell2010
notebooks/Conjugate Gradient.ipynb
View file @ 3d759239
{
"metadata": {
"language": "haskell",
"name": ""
"name": "",
"signature": "sha256:8332eed5b1a2647ecfe6b707d1d07de0e8798861c517cac876970de5eb31e43c"
},
"nbformat": 3,
"nbformat_minor": 0,
......
notebooks/IHaskell.ipynb
View file @ 3d759239
......@@ -204,7 +204,7 @@
]
}
],
"prompt_number": 6
"prompt_number": 5
},
{
"cell_type": "code",
......@@ -279,7 +279,7 @@
]
}
],
"prompt_number": 9
"prompt_number": 6
},
{
"cell_type": "markdown",
......@@ -303,7 +303,7 @@
"output_type": "display_data"
}
],
"prompt_number": 10
"prompt_number": 7
},
{
"cell_type": "markdown",
......@@ -348,7 +348,7 @@
]
}
],
"prompt_number": 11
"prompt_number": 8
},
{
"cell_type": "markdown",
......@@ -368,7 +368,7 @@
"language": "python",
"metadata": {},
"outputs": [],
"prompt_number": 12
"prompt_number": 9
},
{
"cell_type": "markdown",
......@@ -398,7 +398,7 @@
"language": "python",
"metadata": {},
"outputs": [],
"prompt_number": 13
"prompt_number": 10
},
{
"cell_type": "markdown",
......@@ -440,7 +440,7 @@
"output_type": "display_data"
}
],
"prompt_number": 14
"prompt_number": 11
},
{
"cell_type": "markdown",
......@@ -507,7 +507,7 @@
]
}
],
"prompt_number": 15
"prompt_number": 21
},
{
"cell_type": "markdown",
......@@ -573,7 +573,7 @@
]
}
],
"prompt_number": 16
"prompt_number": 12
},
{
"cell_type": "markdown",
......@@ -655,7 +655,7 @@
]
}
],
"prompt_number": 17
"prompt_number": 13
},
{
"cell_type": "markdown",
......@@ -731,7 +731,7 @@
]
}
],
"prompt_number": 18
"prompt_number": 14
},
{
"cell_type": "markdown",
......@@ -981,7 +981,7 @@
]
}
],
"prompt_number": 19
"prompt_number": 15
},
{
"cell_type": "markdown",
......@@ -1121,7 +1121,7 @@
]
}
],
"prompt_number": 22
"prompt_number": 16
},
{
"cell_type": "markdown",
......@@ -1141,7 +1141,7 @@
"language": "python",
"metadata": {},
"outputs": [],
"prompt_number": 23
"prompt_number": 17
},
{
"cell_type": "code",
......@@ -1161,7 +1161,7 @@
]
}
],
"prompt_number": 24
"prompt_number": 18
},
{
"cell_type": "markdown",
......@@ -1184,7 +1184,7 @@
"output_type": "display_data"
}
],
"prompt_number": 25
"prompt_number": 19
},
{
"cell_type": "markdown",
......@@ -1216,7 +1216,7 @@
"output_type": "display_data"
}
],
"prompt_number": 26
"prompt_number": 20
},
{
"cell_type": "markdown",
......@@ -1313,21 +1313,17 @@
"metadata": {},
"outputs": [
{
"html": [
"<span class='err-msg'>Not in scope: `A.B.fib'</span>"
],
"metadata": {},
"output_type": "display_data",
"text": [
"10946"
]
},
{
"metadata": {},
"output_type": "display_data",
"text": [
"10946"
"Not in scope: `A.B.fib'"
]
}
],
"prompt_number": 29
"prompt_number": 22
},
{
"cell_type": "markdown",
......
src/IHaskell/Eval/Evaluate.hs
View file @ 3d759239
......@@ -73,6 +73,7 @@ import Paths_ihaskell (version)
import Data.Version (versionBranch)
import Language.Haskell.GHC.Interpret
import Language.Haskell.GHC.Util
data ErrorOccurred = Success | Failure deriving (Show, Eq)
......@@ -287,20 +288,6 @@ safely state = ghandle handler . ghandle sourceErrorHandler
evalPager = ""
}
doc :: GhcMonad m => SDoc -> m String
doc sdoc = do
flags <- getSessionDynFlags
unqual <- getPrintUnqual
let style = mkUserStyle unqual AllTheWay
let cols = pprCols flags
d = runSDoc sdoc (initSDocContext flags style)
return $ Pretty.fullRender Pretty.PageMode cols 1.5 string_txt "" d
where
string_txt :: Pretty.TextDetails -> String -> String
string_txt (Pretty.Chr c) s = c:s
string_txt (Pretty.Str s1) s2 = s1 ++ s2
string_txt (Pretty.PStr s1) s2 = unpackFS s1 ++ s2
string_txt (Pretty.LStr s1 _) s2 = unpackLitString s1 ++ s2
wrapExecution :: KernelState
......@@ -314,28 +301,6 @@ wrapExecution state exec = safely state $ exec >>= \res ->
evalPager = ""
}
-- | Set dynamic flags.
--
-- This was adapted from GHC's InteractiveUI.hs (newDynFlags).
setDynFlags :: [String] -- ^ Flags to set.
-> Interpreter [ErrMsg] -- ^ Errors from trying to set flags.
setDynFlags ext = do
-- Try to parse flags.
flags <- getSessionDynFlags
(flags', unrecognized, warnings) <- parseDynamicFlags flags (map noLoc ext)
-- First, try to check if this flag matches any extension name.
let restorePkg x = x { packageFlags = packageFlags flags }
let restoredPkgs = flags' { packageFlags = packageFlags flags}
GHC.setProgramDynFlags restoredPkgs
GHC.setInteractiveDynFlags restoredPkgs
-- Create the parse errors.
let noParseErrs = map (("Could not parse: " ++) . unLoc) unrecognized
allWarns = map unLoc warnings ++
["-package not supported yet" | packageFlags flags /= packageFlags flags']
warnErrs = map ("Warning: " ++) allWarns
return $ noParseErrs ++ warnErrs
-- | Return the display data for this command, as well as whether it
-- resulted in an error.
......@@ -415,7 +380,7 @@ evalCommand output (Directive SetDynFlag flags) state =
-- If not a kernel option, must be a dyn flag.
Nothing -> do
errs <- setDynFlags [flag]
errs <- setFlags [flag]
let display = case errs of
[] -> mempty
_ -> displayError $ intercalate "\n" errs
......@@ -472,10 +437,7 @@ evalCommand a (Directive SetOption opts) state = do
evalCommand _ (Directive GetType expr) state = wrapExecution state $ do
write $ "Type: " ++ expr
result <- exprType expr
flags <- getSessionDynFlags
let typeStr = showSDocUnqual flags $ ppr result
return $ formatType typeStr
formatType <$> getType expr
evalCommand _ (Directive LoadFile name) state = wrapExecution state $ do
write $ "Load: " ++ name
......@@ -799,11 +761,8 @@ evalCommand output (Expression expr) state = do
evalCommand _ (Declaration decl) state = wrapExecution state $ do
write $ "Declaration:\n" ++ decl
names <- runDecls decl
dflags <- getSessionDynFlags
let boundNames = map (replace ":Interactive." "" . showPpr dflags) names
nonDataNames = filter (not . isUpper . head) boundNames
boundNames <- evalDeclarations decl
let nonDataNames = filter (not . isUpper . head) boundNames
-- Display the types of all bound names if the option is on.
-- This is similar to GHCi :set +t.
......@@ -811,6 +770,7 @@ evalCommand _ (Declaration decl) state = wrapExecution state $ do
then return mempty
else do
-- Get all the type strings.
dflags <- getSessionDynFlags
types <- forM nonDataNames $ \name -> do
theType <- showSDocUnqual dflags . ppr <$> exprType name
return $ name ++ " :: " ++ theType
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment