diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 50354242acf832e2dabfaa4f3ed4f3879d0b0623..cff79b44136fc3761fd2c00a79dd3882b8b26be7 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -3235,6 +3235,7 @@ instance MonadP P where
   getBit ext = P $ \s -> let b =  ext `xtest` pExtsBitmap (options s)
                          in b `seq` POk s b
   allocateCommentsP ss = P $ \s ->
+    if null (comment_q s) then POk s emptyComments else  -- fast path
     let (comment_q', newAnns) = allocateComments ss (comment_q s) in
       POk s {
          comment_q = comment_q'
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 1dcab296d2ef8461b87df1af0b99d73f8c9f45a1..75ebca80f8c52e1c060ecc18f5613e7a44af72fb 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -3060,6 +3060,7 @@ instance MonadP PV where
       let b = ext `xtest` pExtsBitmap (pv_options ctx) in
       PV_Ok acc $! b
   allocateCommentsP ss = PV $ \_ s ->
+    if null (pv_comment_q s) then PV_Ok s emptyComments else  -- fast path
     let (comment_q', newAnns) = allocateComments ss (pv_comment_q s) in
       PV_Ok s {
          pv_comment_q = comment_q'