-- Do not forget -threaded!
--
module MagicHaskeller.SimpleServer(main') where
import MagicHaskeller.LibTH
import MagicHaskeller.LibExcel
import MagicHaskeller.Individual(availableNames, prioritizedNamesToPg)
import GHC hiding (language)
import HscTypes(HscEnv(hsc_IC), InteractiveContext(..))
#if __GLASGOW_HASKELL__ < 706
import DynFlags hiding (Option, language)
#else
import DynFlags hiding (Option, Language, language)
#endif
import qualified MonadUtils as MU -- clearly distinguish MU.liftIO from Control.Monad.IO.Class.liftIO
-- import Panic (panic)
import Outputable(showPpr)
import Type
import Language.Haskell.TH as TH
import GHC.Paths(libdir)
import Control.Concurrent
import Network
import System.IO
import System.IO.Error(isEOFError)
import Control.Exception
import Data.Char(isAlphaNum, isSpace)
import Text.Html(stringToHtmlString)
import MagicHaskeller.ExpToHtml(QueryOptions(..), defaultQO, expToPlainString, expSigToString, Language(..))
import Unsafe.Coerce
import MagicHaskeller.GetTime
-- import System.Time
import Data.Time
import System.Console.GetOpt
import System.Environment
import System.Exit
import Control.Monad
-- These are for reporting resource usage.
#if __GLASGOW_HASKELL__ >= 700
import GHC.Stats
#endif
import System.Process(system)
import System.Mem(performGC)
import Control.Monad.Par.Class
import Control.Monad.Par.IO
import Control.Monad.IO.Class(MonadIO, liftIO)
-- import Control.Concurrent.ParallelIO(stopGlobalPool)
-- import Data.Map
#ifdef UNIX
-- as suggested by /usr/share/doc/libghc6-network-doc/html/Network.html
import System.Posix hiding (Default)
#endif
#ifdef CABAL
import Paths_MagicHaskeller(getDataFileName)
#endif
-- file:///usr/share/doc/libghc6-network-doc/html/Network.html#t%3APortID
--portID = UnixSocket "mhserver"
portID = PortNumber 55443
trainers = "predicates"
defaultDefault = "(Int,Integer, Double, Ratio Int, Char,(),String)" -- I guess in most cases Int will do.
queryOut = "query.out"
data Flag = Port PortNumber | Socket FilePath | Interactive | RunPSCommand | JustTraining
| Depth Int
| WithDoubleRatio | WithRatio | RatioOnly | WithDouble | Individual FilePath
| WithAbsents
| Default (Maybe String)
| MemoSize (Maybe Int)
| HTML | PlainText
| NoTraining | SequentialTraining FilePath | ParallelTraining FilePath
| PostProcessor String
| Excel
| DumpPrimitives
cmdOpts :: [OptDescr Flag]
cmdOpts = [ Option ['p'] ["port-number"] (ReqArg (Port . toEnum . readOrErr msgp) "PORT_NUMBER") "use port number PORT_NUMBER (default, using -p 55443)"
, Option ['u'] ["unix-socket"] (ReqArg Socket "SOCKET_FILEPATH") "use socket file SOCKET_FILEPATH"
, Option ['i'] ["interactive","stdio"] (NoArg Interactive) "use the standard I/O for query and printing results"
, Option ['r'] ["run-ps-command"] (NoArg RunPSCommand) "(after training) run the ps command and exit"
, Option ['j'] ["just-training"] (NoArg JustTraining) "just training (usually for benchmarking)"
, Option ['d'] ["depth"] (ReqArg (Depth . readOrErr msgd) "SEARCH_DEPTH") $
"search depth (" ++ shows (depth defaultQO) "by default)"
, Option ['q'] ["query-limit"] (OptArg (MemoSize . fmap (readOrErr msgd)) "QUERY_TYPE_SIZE_LIMIT") $
"only look up the memo entries when types with size less than this value are queried. Values for other types are recomputed every time. If no value is given (default), this means there is not limit and all entry types are looked up when queried. Setting this value does not affect the time for looking up already substantiated entries. However, setting it to about 8 dramatically reduces the heap space usage, while increasing the time for training."
, Option ['b'] ["with-double-ratio"] (NoArg WithDoubleRatio) "use the library with Double-related and (Ratio Int)-related functions. This requires more memory, but fractional numbers become available. This overrides --individual, -w, --ratio-only, and -2."
, Option ['w'] ["with-ratio"] (NoArg WithRatio) "use the library with (Ratio Int)-related functions. This requires more memory, but fractional numbers become available. This overrides -b, --individual, --ratio-only, and -2."
, Option [] ["ratio-only"] (NoArg RatioOnly) "use the library only including (Ratio Int)-related functions. This is introduced for debugging, but there may be other uses. This overrides -b, -w, --individual, and -2."
, Option ['2'] ["with-double"] (NoArg WithDouble) "use the library with Double-related functions. This requires more memory, but fractional numbers become available. This overrides -b, -w, --ratio-only, and --individual."
, Option [] ["individual"] (ReqArg Individual "FILEPATH") "itemize library functions and their priorities in FILEPATH. This overrides -b, -w, --ratio-only, and -2. Note that only functions (and non-functions) appearing in the bundled primitives.txt can be used unless you hack the source."
, Option [] ["dump-primitives"] (NoArg DumpPrimitives) "dump a sample primitive file (to be used with --individual=...) to stdout and exit. The bundled primitives.txt is more user-friendly, but this option is useful if you hack the source and add some primitives."
, Option ['a'] ["absents"] (NoArg WithAbsents) "generate functions with unused arguments in addition to other useful ones"
#if __GLASGOW_HASKELL__ >= 706
, Option [] ["default"] (OptArg Default "DEFAULT_TYPES") "default declaration for type defaulting (--default='(Int,Integer,Double, Ratio Int, Char,(),String)' by default). The outermost parens can be omitted."
#endif
, Option ['h'] ["html"] (NoArg HTML) "force printing in HTML even in the interactive mode"
, Option [] ["plain-text"] (NoArg PlainText) "force printing in plain text"
, Option ['n'] ["no-training"] (NoArg NoTraining) "start service without training beforehand"
, Option ['s'] ["sequential-training"] (ReqArg SequentialTraining "PREDICATES_FILEPATH")
"substantiate the memo table using the predicates in PREDICATES_FILEPATH. (Just setting this option would not disable parallel training. If you want to use only sequential training, use `-n -s PREDICATES_FILEPATH'.)"
, Option ['t'] ["threaded-training",
"parallel-training"] (ReqArg ParallelTraining "PREDICATES_FILEPATH")
"substantiate the memo table using the predicates in PREDICATES_FILEPATH in parallel (default, using -t 'predicates'). This option can be set along with -s, then sequential training will be done after parallel training."
, Option [] ["postprocessor"] (ReqArg PostProcessor "POSTPROCESSOR") "use POSTPROCESSOR as the postprocessor (default, using --postprocessor=postprocess). You can use --postprocessor=id to see the internal representation."
, Option ['x'] ["excel"] (NoArg Excel) "use the library for Excel synthesis, disable defaulting to integral numbers, and ppExcel as the postprocessor. You can specify `--excel --postprocessor=blah' in order to use a different postprocessor."
]
where readOrErr msg xs = case reads xs of [(i,"")] | i>=0 -> i
_ -> error msg
msgp = "--port-number (or -p) takes a non-negative integral value specifying the port number."
msgd = "--depth (or -d) takes a non-negative integral value specifying the depth bound."
msgq = "--query-limit (or -q) takes a non-negative integral value specifying the type size bound for memoization."
readOpts :: IO ([Flag], [String])
readOpts = do argv <- getArgs
case (getOpt Permute cmdOpts argv) of
(o,n,[] ) -> return (o,n)
(_,_,errs) -> do hPutStrLn stderr (concat errs)
usage
exitFailure
usage :: IO ()
usage = do progname <- getProgName
hPutStrLn stderr $ usageInfo ("Usage: "++progname++" [OPTION...]") cmdOpts
data HowToServe = Network PortID | STDIO | PS | NoService
data Format = DefaultFormat | ForceHTML | ForcePlain deriving Eq
data FunctionSet = PGFull | PGWithDoubleRatio | PGWithRatio | PGRatio | PGWithDouble | PGExcel | PGIndividual FilePath
data ServerOptions = SO {howToServe :: HowToServe, queryOptions :: QueryOptions, functionSet :: FunctionSet, memoSize :: Maybe Int, defaultTypes :: Maybe String, format :: Format, sequentialTraining :: Maybe FilePath, parallelTraining :: Maybe FilePath, postprocessor :: String, language :: Language, dumpPrimitives :: Bool}
defaultSO = SO {howToServe = Network portID, queryOptions = defaultQO, functionSet = PGFull, memoSize = Nothing, defaultTypes = Just defaultDefault, format = DefaultFormat, sequentialTraining = Nothing, parallelTraining = Just trainers, postprocessor = "postprocess", language = LHaskell, dumpPrimitives = False}
procFlags :: [Flag] -> ServerOptions
procFlags = foldl procFlag defaultSO
procFlag :: ServerOptions -> Flag -> ServerOptions
procFlag st (Port i) = st{howToServe = Network (PortNumber i)}
#ifdef UNIX
procFlag st (Socket fp) = st{howToServe = Network (UnixSocket fp)}
#endif
procFlag st Interactive = st{howToServe = STDIO}
procFlag st RunPSCommand = st{howToServe = PS}
procFlag st JustTraining = st{howToServe = NoService}
procFlag st (Depth d) = st{queryOptions = (queryOptions st){depth = d}}
procFlag st (MemoSize m) = st{memoSize = m}
procFlag st WithDoubleRatio = st{functionSet = PGWithDoubleRatio}
procFlag st WithRatio = st{functionSet = PGWithRatio}
procFlag st RatioOnly = st{functionSet = PGRatio}
procFlag st WithDouble = st{functionSet = PGWithDouble}
procFlag st (Individual file) = st{functionSet = PGIndividual file}
procFlag st WithAbsents = st{queryOptions = (queryOptions st){absents = True}}
#if __GLASGOW_HASKELL__ >= 706
procFlag st (Default ms) = st{defaultTypes = ms}
procFlag st Excel = st{defaultTypes = Just "Int,Double", postprocessor = "ppExcel", functionSet = PGExcel, language = LExcel}
#else
procFlag st (Default ms) = error "The --default option is not available. Please rebuild with GHC >= 7.6."
procFlag st Excel = st{postprocessor = "ppExcel", functionSet = PGExcel, language = LExcel}
#endif
procFlag st HTML = st{format = ForceHTML}
procFlag st PlainText = st{format = ForcePlain}
procFlag st NoTraining = st{sequentialTraining = Nothing, parallelTraining = Nothing}
procFlag st (SequentialTraining fp) = st{sequentialTraining = Just fp}
procFlag st (ParallelTraining fp) = st{parallelTraining = Just fp}
procFlag st (PostProcessor pp) = st{postprocessor = pp}
procFlag st DumpPrimitives = st{dumpPrimitives = True}
main' :: String -> IO ()
main' versionString = do
(flags, _args) <- readOpts
let so = procFlags flags
if dumpPrimitives so then dump else main'' versionString so
dump = putStrLn $ unlines $ "## Lines starting with # will be ignored, so you can exclude individual functions by commenting them out. The number at the beginning of each line represents the priority, where 0 means the most prioritized." : map ("0 "++) availableNames
main'' versionString so = withSocketsDo $ do
hPutStrLn stderr versionString
qhandle <- openFile queryOut AppendMode
hSetBuffering qhandle LineBuffering
beginCT <- getCurrentTime
hPutStrLn stderr ("started at " ++ show beginCT)
pgf <- case (functionSet so, memoSize so) of
(PGFull, Nothing) -> liftIO mkPgFull
(PGFull, Just sz) -> return $ pgfulls !! sz
(PGWithDoubleRatio, Nothing) -> return $ pgWithDoubleRatio
(PGWithDoubleRatio, Just sz) -> return $ pgWithDoubleRatios !! sz
(PGWithRatio, Nothing) -> return $ pgWithRatio
(PGWithRatio, Just sz) -> return $ pgWithRatios !! sz
(PGRatio, Nothing) -> return $ pgRatio
(PGRatio, Just sz) -> return $ pgRatios !! sz
(PGWithDouble, Nothing) -> liftIO mkPgWithDouble
(PGWithDouble, Just sz) -> return $ pgWithDoubles !! sz
(PGExcel, Nothing) -> liftIO mkPgExcel
(PGExcel, Just sz) -> liftIO $ mkPgExcels sz
(PGIndividual file, mb) -> do cs <- readFile file
prioritizedNamesToPg mb $ map parsePrioritizedName $ filter ((/='#').head) $ filter (not.null) $ lines cs
runGhc (Just libdir) $ do
prepareGHCAPI ["MagicHaskeller.Minimal","MagicHaskeller.FastRatio"] -- (Fast)Ratio must be here if Ratio is referred by the default declaration.
#if __GLASGOW_HASKELL__ >= 706
case defaultTypes so of
Nothing -> return ()
Just def -> declareDefaults def
#endif
let stat = (versionString, qhandle, so, pgf)
mbPara <- mbParse (postprocessor so) $ parallelTraining so
-- mbSeq <- mbParse (postprocessor so) $ sequentialTraining so
case (mbPara, sequentialTraining so) of
(Just res, Just fp) -> do -- In this case, we make sure sequantial training starts after all the parallel training processes have finished. (The sequential training will be done for testing and benchmarking purposes.)
liftIO $ trainPara stat res
trainSeq stat fp
(Just res, Nothing) -> do -- In this case, every synthesis should be done in parallel. The service is started while training, but we prefer to be notified when all the training processes finish.
liftIO $ forkIO $ trainPara stat res
return ()
(Nothing, Just fp) -> trainSeq stat fp
(Nothing, Nothing) -> return ()
case howToServe so of
Network pid -> do
#ifdef UNIX
liftIO $ installHandler sigPIPE Ignore Nothing -- as suggested by /usr/share/doc/libghc6-network-doc/html/Network.html
#endif
socket <- liftIO $ listenOn pid
loop stat socket
STDIO -> interactive stat
PS -> liftIO $ do
pgn <- getProgName
system $ "ps u -C "++pgn
return () -- stopGlobalPool
NoService -> return () -- stopGlobalPool
parsePrioritizedName :: String -> (Int,String)
parsePrioritizedName str = case reads str of [] -> error "error while parsing the primitives file."
[(i,s)] -> (i, dropWhile isSpace s)
#if __GLASGOW_HASKELL__ >= 706
declareDefaults str = do
hscEnv <- getSession
# if __GLASGOW_HASKELL__ >= 802
tupTy <- exprType TM_Default $ "undefined :: (" ++ str ++ ")"
# else
tupTy <- exprType $ "undefined :: (" ++ str ++ ")"
# endif
case splitTyConApp_maybe tupTy of
Nothing -> error $ str ++ " : invalid default type sequence"
Just (_tuptc, defaultTypes) -> setSession hscEnv{hsc_IC = (hsc_IC hscEnv){ic_default = Just defaultTypes}}
#endif
loop stat socket = do
(handle, hostname, _portnum) <- liftIO $ accept socket
liftIO $ hPutStr stderr $ "Connection from " ++ hostname ++ ".\n"
liftIO $ hSetBuffering handle LineBuffering
answerHIO True stat handle handle
loop stat socket
{- pgfの計算を入れんといかん.
-- same as main, with option `--interactive --no-training'
mainstd = do hscEnv <- prepareGHCAPI ["MagicHaskeller.Minimal"]
qhandle <- openFile queryOut AppendMode
hSetBuffering qhandle LineBuffering
interactive qhandle defaultSO pgf hscEnv
-}
interactive stat = processSeq "\\f -> ?" stat stdin
{-
interactive stat = do liftIO (hPutStrLn stderr "\\f -> ?")
cont <- answerHIO False stat stdin stdout
when cont $ interactive stat
-}
mbParse postproc Nothing = return Nothing
mbParse postproc (Just fp) = tryOpening fp (\e -> couldNotOpen fp >> return Nothing)
(\h -> fmap Just $ parseHandle postproc h)
tryOpening :: MonadIO m => FilePath -> (IOException -> IO a) -> (Handle -> m a) -> m a
tryOpening fp onException onSuccess = do
r <- liftIO $ try $ openFile fp ReadMode
case r :: Either IOException Handle of
Left e -> do
#ifdef CABAL
fn <- liftIO $ getDataFileName ("MagicHaskeller/"++fp)
s <- liftIO $ try $ openFile fn ReadMode
either (liftIO . onException) onSuccess (s :: Either IOException Handle)
#else
liftIO $ onException e
#endif
Right h -> onSuccess h
trainSeq stat fp = do
tryOpening fp (\e -> couldNotOpen fp)
(\h -> do time $ do
processSeq ("reading from "++fp) (preferPlain stat) h
liftIO $ hPutStrLn stderr "In total,"
return ())
liftIO reportGCSummary
reportGCSummary = do
hPutStrLn stderr "performing GC..."
performGC
hPutStrLn stderr "done.\a"
#if __GLASGOW_HASKELL__ >= 706
# if __GLASGOW_HASKELL__ >= 802
-- base>=4.10
gcStatsAvailable <- getRTSStatsEnabled
when gcStatsAvailable $ getRTSStats >>= print
# else
gcStatsAvailable <- getGCStatsEnabled
when gcStatsAvailable $ getGCStats >>= print
# endif
#endif
processSeq prompt stat h = do
liftIO $ hPutStrLn stderr prompt
cont <- answerHIO False stat h stdout
when cont $ processSeq prompt stat h
couldNotOpen fp = hPutStrLn stderr ("An exception occurred while opening `"++fp++"'. The learner has not been trained in parallel beforehand.")
trainPara stat@(_,_,so,_) res =
liftIO $ do
beginCT <- getCurrentTime
runParIO $ trainParaPar (preferPlain stat) res
-- trainParaIO (preferPlain so) pgf hscEnv $ lines cs
endParaCT <- getCurrentTime
hPutStrLn stderr "All the training processes have finished."
hPutStrLn stderr $ show (diffUTCTime endParaCT beginCT) ++ " have passed since the training started."
preferPlain (vs, qh, so, pgf) = (vs, qh, preferPlain' so, pgf)
preferPlain' so = case format so of DefaultFormat -> so{format=ForcePlain}
_ -> so
type Parsed = (String, Either (ProgGenSF -> Bool -> IO [[Exp]], String) String)
trainParaPar :: (String, Handle, ServerOptions, ProgGenSF) -> [Parsed] -> ParIO ()
trainParaPar stat res = do
ivks <- mapM (\line -> spawn $ liftIO $ fmap snd $ answerSIO stat line) res
ks <- mapM get ivks
sum ks `seq` return ()
-- InteractiveEval.exprTypeで明示的に型推論するってことは,IntegerでなくIntでdefaultしたりしやすいってことか.めんどくさければとりあえずはエラーにしてmonomorphicなのを要求してもよい.
-- package ghcのType.Typeもそんなにややこしい型じゃないし,exprTypeから変換するのが確実でいいか.
-- exprTypeやってcompileExprするのは二度手間ではあるが.
-- てゆーか,もしpackage MagicHaskellerを毎回読み込まなければならないとすればそっちの方がtime consuming.
filterCompileIO :: GhcMonad m => String -> String -> m (ProgGenSF -> Bool -> IO [[Exp]])
filterCompileIO postprocessor predStr = fmap unsafeCoerce (compileExpr ("MagicHaskeller.Minimal.f1EFIO " ++ postprocessor ++ " (\\f -> (("++predStr++") :: Bool))"))
{- 使わんかも.
ghcTypeToType :: TyConLib -> GHC.Type -> MagicHaskeller.Types.Type
ghcTypeToType _ (TyVarTy var) = strToVarType $ show var
ghcTypeToType tcl (AppTy t0 t1) = ghcTypeToType tcl t0 `TA` ghcTypeToType tcl t1
ghcTypeToType tcl (TyConApp tc ts) = let nstr = showSDoc (pprParenSymName tc)
tc' = case Data.Map.lookup nstr (fst tcl) of
Nothing -> TC $ (-1 - bakaHash nstr) -- error "nameToTyCon: unknown TyCon"
Just c -> TC c
in foldl TA tc' $ map (thcTypeToType tcl) ts
ghcTypeToType tcl (FunTy t0 t1) = ghcTypeToType tcl t0 :-> ghcTypeToType tcl t1
ghcTypeToType tcl (ForAllTy v ty) = panic "Please make it monomorphic by giving a type signature."
-}
parseHandle :: String -> Handle -> Ghc [Parsed]
parseHandle postproc h = do
cs <- liftIO $ hGetContents h
let css = lines cs
mapM (\xs -> compileOrFail postproc xs >>= \r -> return (xs,r)) css
-- stdinとstdoutで動作確認できるように,inとoutを分ける.
answerHIO forkOrNot (versionString, qhandle, so, pgf) ihandle ohandle = do
eithinp <- liftIO $ try $ hGetLine ihandle -- hGetContents ihandleだと,最後に改行文字を入れちゃった時面倒.あと,hGetContentsの方がだいぶ遅いみたい.
case eithinp of
Left e | isEOFError e -> return False
| otherwise -> do liftIO $ hPutStrLn stderr $ show e
return False
Right inp -> do
case lex inp of
[(":",rest)] -> liftIO $ hPutStrLn ohandle $ if filter (not . isSpace) rest == "version" then versionString else inp ++ " : command unknown"
_ -> do
let (so', pred) = case reads inp of [(qo, pred)] -> (so{queryOptions=qo}, pred)
[] -> (so, inp)
cmpd <- compileOrFail (postprocessor so') pred
liftIO $ (if forkOrNot then fmap (\_->()) . forkIO else id) $ do
putStrLn ("the predicate is "++pred)
hPutStrLn qhandle pred
(if forkOrNot then id else fmap fst . time) $ do
(out,_) <- answerSIO (versionString, qhandle, so', pgf) (pred,cmpd)
hPutStrLn ohandle out
when forkOrNot $ do
hPutStrLn stderr "closing"
hClose ohandle
return True
answerSIO :: (a, b, ServerOptions, ProgGenSF) -> Parsed -> IO (String, Int)
answerSIO (_, _, so, pgf) (pred,cmpd) = do
case cmpd of Left (funIO, sig) -> do
let e2s = case howToServe so of
STDIO | not $ format so == ForceHTML -> expToPlainString
_ | format so == ForcePlain -> expToPlainString
| otherwise -> expSigToString (language so) pred sig
result <- funIO pgf $ absents $ queryOptions so
let ess = take (depth $ queryOptions so) result
-- let ess = take (depth $ queryOptions so) $ fun pgf $ absents $ queryOptions so
return (unlines $ map (concat . map e2s) ess, length $ last ess)
Right errstr -> return ('!' : encodeBR (stringToHtmlString errstr), length errstr) -- 本当はこれもhowToServeにあわせるべき
compileOrFail :: String -> String -> Ghc (Either (ProgGenSF -> Bool -> IO [[Exp]], String) String)
compileOrFail postproc predStr = handleSourceError (return . Right . show) $ do
funIO <- filterCompileIO postproc predStr
#if __GLASGOW_HASKELL__ >= 706
-- In this case, the type obtained by exprType is polymorphic, so there is no point in adding the type signature.
let sig = ""
#else
ty <- exprType $ "\\f->("++predStr++")`asTypeOf`True" -- `asTypeOf` True をいれないと、 predStr = "f True True" のときにserverがpanic!になる。
let sig = " :: " ++ removeQuantification (map crlfToSpace $ showPpr $ extractArgTy ty)
#endif
return $ Left (funIO, sig)
-- Note that the following causes a type mismatch with ghc>=8.0 because mkForAllTys takes TyBinder (which includes visibility info).
#if __GLASGOW_HASKELL__ < 706
-- assumes rank-1 types
extractArgTy ty = case splitForAllTys ty of (tvs, fty) -> case splitFunTys fty of (args, _bool) -> mkForAllTys tvs $ mkFunTys (Prelude.init args) $ last args
#endif
crlfToSpace '\n' = ' '
crlfToSpace c = c
-- エラーコード中にもし\nがあった場合,
で置き換え.なぜかstringToHtmlStringはやってくれない.
encodeBR = concat . map (++"
") . lines
-- exprType quantifies each Primitive type with `GHC.Types.' and `GHC.Bool., but mueval does not like this kind of quantification.
-- There exist quicker algorithms, but anyway the time for quantification removal should be ignorable.
removeQuantification "" = ""
removeQuantification xs@(y:ys) = case span (/='.') xs of (tk,'.':dr) | all isAlphaNum tk -> removeQuantification dr
| otherwise -> reverse (dropWhile isAlphaNum $ reverse tk) ++ removeQuantification dr
(tk,"") -> tk
prepareGHCAPI :: [FilePath] -> Ghc ()
prepareGHCAPI allfss = do
dfs <- getSessionDynFlags
#if __GLASGOW_HASKELL__ >= 700
-- x # if __GLASGOW_HASKELL__ >= 708
-- x let newf = xopt_set dfs{packageFlags = [ packageNameToFlag "MagicHaskeller" ], optLevel=2, parMakeCount=Nothing} Opt_ExtendedDefaultRules -- parMakeCount=Nothing corresponds to -j. See http://downloads.haskell.org/~ghc/7.10.2/docs/html/libraries/ghc-7.10.2/DynFlags.html -- but seemingly this does not make the code faster, so is commented out.
-- x # else
let newf = xopt_set dfs{packageFlags = [ packageNameToFlag "MagicHaskeller" ], optLevel=2}
# if __GLASGOW_HASKELL__ >= 800
ExtendedDefaultRules
# else
Opt_ExtendedDefaultRules
# endif
-- x # endif
#else
let newf = dfs{packageFlags = [ packageNameToFlag "MagicHaskeller" ], optLevel=2}
#endif
setSessionDynFlags newf -- result abandoned
#if __GLASGOW_HASKELL__ >= 700
modules <- mapM (\fs -> fmap (\x -> (x,Nothing)) $ findModule (mkModuleName fs) Nothing) ("Prelude":allfss)
# if __GLASGOW_HASKELL__ >= 802
setContext [ IIDecl $ (simpleImportDecl . mkModuleName $ moduleName) | moduleName <- "Prelude":allfss ] -- idelcQualified of simpleImportDecl is False at least since 8.2, and becomes ImportDeclQualifiedStyle at ghc-api-compat
# else
setContext [ IIDecl $ (simpleImportDecl . mkModuleName $ moduleName){GHC.ideclQualified = False} | moduleName <- "Prelude":allfss ] -- GHC 7.4
# endif
#else
modules <- mapM (\fs -> findModule (mkModuleName fs) Nothing) ("Prelude":allfss)
setContext [] modules
#endif
packageNameToFlag :: String -> PackageFlag
#if __GLASGOW_HASKELL__ < 710
packageNameToFlag = ExposePackage
#else
# if __GLASGOW_HASKELL__ < 800
packageNameToFlag name = ExposePackage (PackageArg name) (ModRenaming False []) -- I am not sure this is the correct conversion, because I could not find any documentation on the change.
# else
packageNameToFlag name = ExposePackage ("-package "++name) (PackageArg name) (ModRenaming False []) -- I am not sure this is the correct conversion, because I could not find any documentation on the change.
# endif
#endif