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, 2 years 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)