Ticket #8051: ticket-8051-multi-line-number-fix.v3.patch

File ticket-8051-multi-line-number-fix.v3.patch, 4.1 KB (added by hvr, 21 months ago)

3rd attempt at fixing stuff; as a side-effect, this one also fixes wrong single-line column-indices in error messages

  • ghc/InteractiveUI.hs

    From 85fd5d7e72f449cf7870c28a1bfc405bd0c0b5d3 Mon Sep 17 00:00:00 2001
    From: Herbert Valerio Riedel <[email protected]>
    Date: Thu, 11 Jul 2013 18:21:29 +0200
    Subject: Fix multi-line input line-numbers & interaction between `:{` and `:set +m`
    
    This fixes #8051
    ---
     ghc/InteractiveUI.hs | 41 ++++++++++++++++++++++++++++++++++-------
     1 file changed, 34 insertions(+), 7 deletions(-)
    
    diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
    index 68380b3..cef0003 100644
    a b runOneCommand eh gCmd = do 
    716716                            (\c -> case removeSpaces c of 
    717717                                     ""   -> noSpace q 
    718718                                     ":{" -> multiLineCmd q 
    719                                      c'   -> return (Just c') ) 
     719                                     _    -> return (Just c) ) 
    720720    multiLineCmd q = do 
    721721      st <- lift getGHCiState 
    722722      let p = prompt st 
    runOneCommand eh gCmd = do 
    735735    collectCommand q c = q >>= 
    736736      maybe (liftIO (ioError collectError)) 
    737737            (\l->if removeSpaces l == ":}" 
    738                  then return (Just $ removeSpaces c) 
     738                 then return (Just c) 
    739739                 else collectCommand q (c ++ "\n" ++ map normSpace l)) 
    740740      where normSpace '\r' = ' ' 
    741741            normSpace   x  = x 
    runOneCommand eh gCmd = do 
    746746    doCommand :: String -> InputT GHCi (Maybe Bool) 
    747747 
    748748    -- command 
    749     doCommand (':' : cmd) = do 
     749    doCommand stmt | (':' : cmd) <- removeSpaces stmt = do 
    750750      result <- specialCommand cmd 
    751751      case result of 
    752752        True -> return Nothing 
    runOneCommand eh gCmd = do 
    754754 
    755755    -- haskell 
    756756    doCommand stmt = do 
     757      -- if 'stmt' was entered via ':{' it will contain '\n's 
     758      let stmt_nl_cnt = length [ () | '\n' <- stmt ] 
    757759      ml <- lift $ isOptionSet Multiline 
    758       if ml 
     760      if ml && stmt_nl_cnt == 0 -- don't trigger automatic multi-line mode for ':{'-multiline input 
    759761        then do 
     762          fst_line_num <- lift (line_number <$> getGHCiState) 
    760763          mb_stmt <- checkInputForLayout stmt gCmd 
    761764          case mb_stmt of 
    762765            Nothing      -> return $ Just True 
    763766            Just ml_stmt -> do 
    764               result <- timeIt $ lift $ runStmt ml_stmt GHC.RunToCompletion 
     767              -- temporarily compensate line-number for multi-line input 
     768              result <- timeIt $ lift $ runStmtWithLineNum fst_line_num ml_stmt GHC.RunToCompletion 
    765769              return $ Just result 
    766         else do 
    767           result <- timeIt $ lift $ runStmt stmt GHC.RunToCompletion 
     770        else do -- single line input and :{-multiline input 
     771          last_line_num <- lift (line_number <$> getGHCiState) 
     772          -- reconstruct first line num from last line num and stmt 
     773          let fst_line_num | stmt_nl_cnt > 0 = last_line_num - (stmt_nl_cnt2 + 1) 
     774                           | otherwise = last_line_num -- single line input 
     775              stmt_nl_cnt2 = length [ () | '\n' <- stmt' ] 
     776              stmt' = dropLeadingWhiteLines stmt -- runStmt doesn't like leading empty lines 
     777          -- temporarily compensate line-number for multi-line input 
     778          result <- timeIt $ lift $ runStmtWithLineNum fst_line_num stmt' GHC.RunToCompletion 
    768779          return $ Just result 
    769780 
     781    -- runStmt wrapper for temporarily overridden line-number 
     782    runStmtWithLineNum :: Int -> String -> SingleStep -> GHCi Bool 
     783    runStmtWithLineNum lnum stmt step = do 
     784        st0 <- getGHCiState 
     785        setGHCiState st0 { line_number = lnum } 
     786        result <- runStmt stmt step 
     787        -- restore original line_number 
     788        getGHCiState >>= \st -> setGHCiState st { line_number = line_number st0 } 
     789        return result 
     790 
     791    -- note: this is subtly different from 'unlines . dropWhile (all isSpace) . lines' 
     792    dropLeadingWhiteLines s | (l0,'\n':r) <- break (=='\n') s 
     793                            , all isSpace l0 = dropLeadingWhiteLines r 
     794                            | otherwise = s 
     795 
     796 
    770797-- #4316 
    771798-- lex the input.  If there is an unclosed layout context, request input 
    772799checkInputForLayout :: String -> InputT GHCi (Maybe String)