From 6df3ee72bbf52ded23f139f043c9eb21f3295b42 Mon Sep 17 00:00:00 2001 From: Andrew Gibiansky Date: Wed, 27 May 2015 18:31:37 +0200 Subject: [PATCH] Fixing kernel death, closes #505 --- ihaskell.cabal | 43 +++------- main/IHaskellPrelude.hs | 149 ++++++++++++++++++++++++++++++++++ {src => main}/Main.hs | 0 src/IHaskell/Eval/Evaluate.hs | 24 +++--- src/IHaskellPrelude.hs | 1 + 5 files changed, 174 insertions(+), 43 deletions(-) create mode 100644 main/IHaskellPrelude.hs rename {src => main}/Main.hs (100%) diff --git a/ihaskell.cabal b/ihaskell.cabal index 838d73be..22656de5 100644 --- a/ihaskell.cabal +++ b/ihaskell.cabal @@ -127,7 +127,7 @@ library executable ihaskell -- .hs or .lhs file containing the Main module. main-is: Main.hs - hs-source-dirs: src + hs-source-dirs: main other-modules: IHaskellPrelude ghc-options: -threaded @@ -135,43 +135,20 @@ executable ihaskell -- Other library packages from which modules are imported. default-language: Haskell2010 build-depends: - aeson >=0.7 && < 0.9, + ihaskell -any, base >=4.6 && < 4.9, - base64-bytestring >=1.0, - bytestring >=0.10, - cereal >=0.3, - cmdargs >=0.10, - containers >=0.5, - directory -any, - filepath -any, - ghc >=7.6 || < 7.11, - ghc-parser >=0.1.7, - ghc-paths ==0.1.*, - haskeline -any, - here ==1.2.*, - hlint >=1.9 && <2.0, - haskell-src-exts ==1.16.*, - http-client == 0.4.*, - http-client-tls == 0.2.*, - MissingH >=1.2, - mtl >=2.1, - parsec -any, - process >=1.1, - random >=1.0, - shelly >=1.5, - split >= 0.2, - stm -any, - strict >=0.3, - system-argv0 -any, - system-filepath -any, text >=0.11, transformers -any, + ghc >=7.6 || < 7.11, + here ==1.2.*, + aeson >=0.7 && < 0.9, + bytestring >=0.10, + containers >=0.5, + strict >=0.3, unix >= 2.6, - unordered-containers -any, - utf8-string -any, - uuid >=1.3, - vector -any, + directory -any, ipython-kernel >=0.6.1 + if flag(binPkgDb) build-depends: bin-package-db diff --git a/main/IHaskellPrelude.hs b/main/IHaskellPrelude.hs new file mode 100644 index 00000000..4938a5a4 --- /dev/null +++ b/main/IHaskellPrelude.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE CPP #-} +module IHaskellPrelude ( + module IHaskellPrelude, + module X, + + -- Select reexports + Data.Typeable.Typeable, + Data.Typeable.cast, + +#if MIN_VERSION_ghc(7,8,0) + Data.Typeable.Proxy, + + GHC.Exts.IsString, + GHC.Exts.IsList, +#endif + + System.IO.hPutStrLn, + System.IO.hPutStr, + System.IO.hPutChar, + System.IO.hPrint, + System.IO.stdout, + System.IO.stderr, + System.IO.stdin, + System.IO.getChar, + System.IO.getLine, + System.IO.writeFile, + System.IO.Handle, + + System.IO.Strict.readFile, + System.IO.Strict.getContents, + System.IO.Strict.hGetContents, + + Control.Exception.catch, + Control.Exception.SomeException, + + Control.Applicative.Applicative(..), + Control.Applicative.ZipList(..), + (Control.Applicative.<$>), + + Control.Concurrent.MVar.MVar, + Control.Concurrent.MVar.newMVar, + Control.Concurrent.MVar.newEmptyMVar, + Control.Concurrent.MVar.isEmptyMVar, + Control.Concurrent.MVar.readMVar, + Control.Concurrent.MVar.takeMVar, + Control.Concurrent.MVar.putMVar, + Control.Concurrent.MVar.modifyMVar, + Control.Concurrent.MVar.modifyMVar_, + + Data.IORef.IORef, + Data.IORef.readIORef, + Data.IORef.writeIORef, + Data.IORef.modifyIORef', + Data.IORef.newIORef, + + + + -- Miscellaneous names + Data.Map.Map, + GHC.IO.FilePath, + Data.Text.Text, + Data.ByteString.ByteString, + Text.Printf.printf, + Data.Function.on, + ) where + +import Prelude + +import Data.Monoid as X +import Data.Tuple as X +import Control.Monad as X +import Data.Maybe as X +import Data.Either as X +import Control.Monad.IO.Class as X +import Data.Ord as X +import GHC.Show as X +import GHC.Enum as X +import GHC.Num as X +import GHC.Real as X +import GHC.Err as X hiding (absentErr) +#if MIN_VERSION_ghc(7,10,0) +import GHC.Base as X hiding (Any, mapM, foldr, sequence, many, (<|>)) +#else +import GHC.Base as X hiding (Any) +#endif +import Data.List as X hiding (head, last, tail, init, transpose, subsequences, permutations, + foldl, foldl1, maximum, minimum, scanl, scanl1, scanr, scanr1, + span, break, mapAccumL, mapAccumR, dropWhileEnd, (!!), + elemIndices, elemIndex, findIndex, findIndices, zip5, zip6, + zip7, zipWith5, zipWith6, zipWith7, unzip5, unzip6, unzip6, + delete, union, lookup, intersect, insert, deleteBy, + deleteFirstBy, unionBy, intersectBy, group, groupBy, insertBy, + maximumBy, minimumBy, genericLength, genericDrop, genericTake, + genericSplitAt, genericIndex, genericReplicate, inits, tails) + +import qualified Control.Applicative +import qualified Data.Typeable +import qualified Data.IORef +import qualified Data.Map +import qualified Data.Text +import qualified Data.Text.Lazy +import qualified Data.ByteString +import qualified Data.ByteString.Lazy +import qualified Data.Function +import qualified GHC.Exts +import qualified System.IO +import qualified System.IO.Strict +import qualified GHC.IO +import qualified Text.Printf +import qualified Control.Exception +import qualified Control.Concurrent.MVar + +import qualified Data.List +import qualified Prelude as P + +type LByteString = Data.ByteString.Lazy.ByteString + +type LText = Data.Text.Lazy.Text + +(headMay, tailMay, lastMay, initMay, maximumMay, minimumMay) = + (wrapEmpty head, wrapEmpty tail, wrapEmpty last, + wrapEmpty init, wrapEmpty maximum, wrapEmpty minimum) + where + wrapEmpty :: ([a] -> b) -> [a] -> Maybe b + wrapEmpty _ [] = Nothing + wrapEmpty f xs = Just (f xs) + +maximumByMay :: (a -> a -> Ordering) -> [a] -> Maybe a +maximumByMay _ [] = Nothing +maximumByMay f xs = Just (Data.List.maximumBy f xs) + +minimumByMay :: (a -> a -> Ordering) -> [a] -> Maybe a +minimumByMay _ [] = Nothing +minimumByMay f xs = Just (Data.List.minimumBy f xs) + +readMay :: Read a => String -> Maybe a +readMay = fmap fst . headMay . reads + +putStrLn :: (MonadIO m) => String -> m () +putStrLn = liftIO . P.putStrLn + +putStr :: (MonadIO m) => String -> m () +putStr = liftIO . P.putStr + +putChar :: MonadIO m => Char -> m () +putChar = liftIO . P.putChar + +print :: (MonadIO m, Show a) => a -> m () +print = liftIO . P.print diff --git a/src/Main.hs b/main/Main.hs similarity index 100% rename from src/Main.hs rename to main/Main.hs diff --git a/src/IHaskell/Eval/Evaluate.hs b/src/IHaskell/Eval/Evaluate.hs index fc311de7..557a6be8 100644 --- a/src/IHaskell/Eval/Evaluate.hs +++ b/src/IHaskell/Eval/Evaluate.hs @@ -350,20 +350,24 @@ evaluate kernelState code output = do TypeRep fing2 tycon2 subs2 = actualTypeRep in error $ concat [ "Expecting value of type " - , show expectedTypeRep + , showTypeRep expectedTypeRep , " but got value of type " - , show actualTypeRep - , "\n. Fingerprint expected " - , show fing1 - , " but gotten " - , show fing2 - , " with expected tycon " - , show (tyConPackage tycon1, tyConModule tycon1, tyConName tycon1, tyConHash tycon1) - , " but gotten " - , show (tyConPackage tycon2, tyConModule tycon2, tyConName tycon2, tyConHash tycon2) + , showTypeRep actualTypeRep ] Just result -> return result + showTypeRep :: TypeRep -> String + showTypeRep (TypeRep fingerprint tycon subs) = + concat ["TypeRep " + , show fingerprint + , " " + , show (tyConPackage tycon, tyConModule tycon, tyConName tycon, tyConHash tycon) + , " " + , "[" + , intercalate ", " (map showTypeRep subs) + , "]" + ] + safely :: KernelState -> Interpreter EvalOut -> Interpreter EvalOut safely state = ghandle handler . ghandle sourceErrorHandler where diff --git a/src/IHaskellPrelude.hs b/src/IHaskellPrelude.hs index fcb160eb..4938a5a4 100644 --- a/src/IHaskellPrelude.hs +++ b/src/IHaskellPrelude.hs @@ -77,6 +77,7 @@ import GHC.Show as X import GHC.Enum as X import GHC.Num as X import GHC.Real as X +import GHC.Err as X hiding (absentErr) #if MIN_VERSION_ghc(7,10,0) import GHC.Base as X hiding (Any, mapM, foldr, sequence, many, (<|>)) #else