diff options
| author | Austin Seipp <austin@well-typed.com> | 2013-09-29 17:22:22 -0500 |
|---|---|---|
| committer | Austin Seipp <austin@well-typed.com> | 2013-09-29 17:22:24 -0500 |
| commit | 6a8e733aa2dc83e1ce66649c4d5a75dbc427d8a0 (patch) | |
| tree | 3e4f422688ebb81bee153d2e5fa3693a5a4e71b3 /testsuite/tests/ghci.debugger | |
| parent | 883fd49fa4c061fa20b2f33e468d4f64b18fc8b2 (diff) | |
| download | haskell-6a8e733aa2dc83e1ce66649c4d5a75dbc427d8a0.tar.gz | |
Fix fallout from making lazy unlifted bindings an error
Issue #8022
Signed-off-by: Austin Seipp <austin@well-typed.com>
Diffstat (limited to 'testsuite/tests/ghci.debugger')
| -rw-r--r-- | testsuite/tests/ghci.debugger/HappyTest.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/ghci.debugger/scripts/print020.stderr | 31 |
2 files changed, 4 insertions, 35 deletions
diff --git a/testsuite/tests/ghci.debugger/HappyTest.hs b/testsuite/tests/ghci.debugger/HappyTest.hs index 62b055fad7..02c6a96e2a 100644 --- a/testsuite/tests/ghci.debugger/HappyTest.hs +++ b/testsuite/tests/ghci.debugger/HappyTest.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, MagicHash #-} +{-# LANGUAGE CPP, MagicHash, BangPatterns #-} import Data.Char import Data.Array import GHC.Exts @@ -416,7 +416,7 @@ happyReduce k i fn 0# tk st sts stk = happyFail 0# tk st sts stk happyReduce k nt fn j tk st sts stk = case happyDrop (k -# (1# :: Int#)) sts of - sts1@((HappyCons (st1@(action)) (_))) -> + !sts1@((HappyCons (st1@(action)) (_))) -> let r = fn stk in -- it doesn't hurt to always seq here... happyDoSeq r (happyGoto nt j tk st1 sts1 r) @@ -424,14 +424,14 @@ happyMonadReduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonadReduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) + where !sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk happyMonad2Reduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonad2Reduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) + where !sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk off = indexShortOffAddr happyGotoOffsets st1 diff --git a/testsuite/tests/ghci.debugger/scripts/print020.stderr b/testsuite/tests/ghci.debugger/scripts/print020.stderr index 6642bb7baa..e69de29bb2 100644 --- a/testsuite/tests/ghci.debugger/scripts/print020.stderr +++ b/testsuite/tests/ghci.debugger/scripts/print020.stderr @@ -1,31 +0,0 @@ - -GenericTemplate.hs:219:14: Warning: - Pattern bindings containing unlifted types should use an outermost bang pattern: - sts1@((HappyCons (st1@(action)) (_))) - = happyDrop k (HappyCons (st) (sts)) - In an equation for ‛happyMonadReduce’: - happyMonadReduce k nt fn j tk st sts stk - = happyThen1 - (fn stk tk) - (\ r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where - sts1@((HappyCons (st1@(action)) (_))) - = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k stk - -GenericTemplate.hs:226:14: Warning: - Pattern bindings containing unlifted types should use an outermost bang pattern: - sts1@((HappyCons (st1@(action)) (_))) - = happyDrop k (HappyCons (st) (sts)) - In an equation for ‛happyMonad2Reduce’: - happyMonad2Reduce k nt fn j tk st sts stk - = happyThen1 - (fn stk tk) - (\ r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) - where - sts1@((HappyCons (st1@(action)) (_))) - = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k stk - off = indexShortOffAddr happyGotoOffsets st1 - off_i = (off +# nt) - .... |