Fixed error messages for RecursiveDo (#8501)

Changes in a few different places to catch several different
types of error related to RecursiveDo

Signed-off-by: Rupert Horlick <ruperthorlick@gmail.com>

Test Plan: Three test cases, with further tests in comments

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3271

1 files changed, 15 insertions, 0 deletions

diff --git a/compiler/utils/StringBuffer.hs b/compiler/utils/StringBuffer.hs
index bac752ac28..ec5184a1c2 100644
--- a/compiler/utils/StringBuffer.hs
+++ b/compiler/utils/StringBuffer.hs
@@ -36,6 +36,7 @@ module StringBuffer
         -- * Conversion
         lexemeToString,
         lexemeToFastString,
+        decodePrevNChars,
 
          -- * Parsing integers
         parseUnsignedInteger,
@@ -263,6 +264,20 @@ lexemeToFastString (StringBuffer buf _ cur) len =
      withForeignPtr buf $ \ptr ->
        return $! mkFastStringBytes (ptr `plusPtr` cur) len
 
+-- | Return the previous @n@ characters (or fewer if we are less than @n@
+-- characters into the buffer.
+decodePrevNChars :: Int -> StringBuffer -> String
+decodePrevNChars n (StringBuffer buf _ cur) =
+    inlinePerformIO $ withForeignPtr buf $ \p0 ->
+      go p0 n "" (p0 `plusPtr` (cur - 1))
+  where
+    go :: Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String
+    go buf0 n acc p | n == 0 || buf0 >= p = return acc
+    go buf0 n acc p = do
+        p' <- utf8PrevChar p
+        let (c,_) = utf8DecodeChar p'
+        go buf0 (n - 1) (c:acc) p'
+
 -- -----------------------------------------------------------------------------
 -- Parsing integer strings in various bases
 parseUnsignedInteger :: StringBuffer -> Int -> Integer -> (Char->Int) -> Integer