+ doCommand (':' : cmd) = do
+ result <- specialCommand cmd
+ case result of
+ True -> return Nothing
+ _ -> return $ Just True
+ doCommand stmt = do
+ ml <- lift $ isOptionSet Multiline
+ if ml
+ then do
+ mb_stmt <- checkInputForLayout stmt getCmd
+ case mb_stmt of
+ Nothing -> return $ Just True
+ Just ml_stmt -> do
+ result <- timeIt $ lift $ runStmt ml_stmt GHC.RunToCompletion
+ return $ Just result
+ else do
+ result <- timeIt $ lift $ runStmt stmt GHC.RunToCompletion
+ return $ Just result
+
+-- #4316
+-- lex the input. If there is an unclosed layout context, request input
+checkInputForLayout :: String -> InputT GHCi (Maybe String)
+ -> InputT GHCi (Maybe String)
+checkInputForLayout stmt getStmt = do
+ dflags' <- lift $ getDynFlags
+ let dflags = xopt_set dflags' Opt_AlternativeLayoutRule
+ st <- lift $ getGHCiState
+ let buf = stringToStringBuffer stmt
+ loc = mkRealSrcLoc (fsLit (progname st)) (line_number st) 1
+ pstate = Lexer.mkPState dflags buf loc
+ case Lexer.unP goToEnd pstate of
+ (Lexer.POk _ False) -> return $ Just stmt
+ _other -> do
+ st <- lift getGHCiState
+ let p = prompt st
+ lift $ setGHCiState st{ prompt = "%s| " }
+ mb_stmt <- ghciHandle (\ex -> case fromException ex of
+ Just UserInterrupt -> return Nothing
+ _ -> case fromException ex of
+ Just ghc_e ->
+ do liftIO (print (ghc_e :: GhcException))
+ return Nothing
+ _other -> liftIO (Exception.throwIO ex))
+ getStmt
+ lift $ getGHCiState >>= \st->setGHCiState st{ prompt = p }
+ -- the recursive call does not recycle parser state
+ -- as we use a new string buffer
+ case mb_stmt of
+ Nothing -> return Nothing
+ Just str -> if str == ""
+ then return $ Just stmt
+ else do
+ checkInputForLayout (stmt++"\n"++str) getStmt
+ where goToEnd = do
+ eof <- Lexer.nextIsEOF
+ if eof
+ then Lexer.activeContext
+ else Lexer.lexer return >> goToEnd
projects / ghc-hetmet.git / blobdiff