Skip to content

Fix #339: do not emit GHC-7.10 conditionals #340

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
andreasabel merged 4 commits into from
Jul 17, 2025
Merged

Fix #339: do not emit GHC-7.10 conditionals #340

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
0d18cbb
Fix #339: do not emit GHC-7.10 conditionals
andreasabel Jul 16, 2025
ddfc0ef
Fix #341: do not empty `import Data.Function` twice!
andreasabel Jul 16, 2025
43a11a4
Run lib/frontend/bootstrap.sh regnerating parsers'
andreasabel Jul 16, 2025
d1c2993
Bump happy version to 2.1.6
andreasabel Jul 17, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 11 additions & 0 deletions ChangeLog.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,16 @@
# Revision history for Happy

## 2.1.6

* No longer emit `{-# LANGUAGE PartialTypeSignatures #-}` twice
([#339](https://github.com/haskell/happy/issues/339)).

* No longer emit `import Data.Function` twice
([#341](https://github.com/haskell/happy/issues/341)).

* Tested with GHC 8.0 - 9.12.2.
The Haskell code generated by Happy is for GHC 8.0 and up.

## 2.1.5

Add `Data.Tuple` to `Happy_Prelude` in order to fix the `--debug` build (#330).
Expand Down
4 changes: 2 additions & 2 deletions happy.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: happy
version: 2.1.5
version: 2.1.6
license: BSD2
license-file: LICENSE
copyright: (c) Andy Gill, Simon Marlow
Expand Down Expand Up @@ -140,7 +140,7 @@ executable happy
array,
containers >= 0.4.2,
mtl >= 2.2.1,
happy-lib == 2.1.5
happy-lib == 2.1.6

default-language: Haskell98
default-extensions: CPP, MagicHash, FlexibleContexts, NamedFieldPuns
Expand Down
28 changes: 15 additions & 13 deletions lib/backend-lalr/src/Happy/Backend/LALR.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,19 +35,21 @@ importsToInject debug = concat ["\n", import_prelude, import_array, import_bits,
import_applicative = "import Control.Applicative(Applicative(..))\n" ++
"import Control.Monad (ap)\n"
import_prelude = unlines $ map (\ x -> unwords ["import qualified", x, "as Happy_Prelude"]) $
[ "Data.Function"
, "Data.Bool"
, "Data.Function"
, "Data.Maybe"
, "Data.Int"
, "Data.String"
, "Data.Tuple"
, "Data.List"
, "Control.Monad"
, "Text.Show"
, "GHC.Num"
, "GHC.Err"
]
-- Keep this list alphabetically ordered!
-- The style of list notation here has been chosen so that these lines can be sorted mechanically,
-- e.g. in Emacs with M-x sort-lines.
"Control.Monad" :
"Data.Bool" :
"Data.Function" :
"Data.Int" :
"Data.List" :
"Data.Maybe" :
"Data.String" :
"Data.Tuple" :
"GHC.Err" :
"GHC.Num" :
"Text.Show" :
[]

langExtsToInject :: [String]
langExtsToInject = ["MagicHash", "BangPatterns", "TypeSynonymInstances", "FlexibleInstances", "PatternGuards", "NoStrictData", "UnboxedTuples", "PartialTypeSignatures"]
Expand Down
20 changes: 2 additions & 18 deletions lib/backend-lalr/src/Happy/Backend/LALR/ProduceCode.lhs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -91,8 +91,6 @@ Produce the complete output file.
> -- XXX Happy-generated code is full of warnings. Some are easy to
> -- fix, others not so easy, and others would require GHC version
> -- #ifdefs. For now I'm just disabling all of them.
>
> partTySigs_opts = ifGeGhc710 (str "{-# LANGUAGE PartialTypeSignatures #-}" . nl)

We used to emit tabs for indentation, but since 2.0.0.1 we use 8 spaces for back-compat (#303):

Expand All @@ -105,29 +103,15 @@ We used to emit tabs for indentation, but since 2.0.0.1 we use 8 spaces for back
> pty = str monad_tycon -- str "P"
> ptyAt a = brack' (pty . str " " . a) -- \(str "a") -> str "(P a)"
> pcont = str monad_context -- str "Read a", some constraint for "P" to be a monad
>
> -- If GHC is enabled, wrap the content in a CPP ifdef that includes the
> -- content and tests whether the GHC version is >= 7.10.3
> ifGeGhc710 :: (String -> String) -> String -> String
> ifGeGhc710 content = str "#if __GLASGOW_HASKELL__ >= 710" . nl
> . content
> . str "#endif" . nl

> n_missing_types = length (filter isNothing (elems nt_types))
> happyAbsSyn = str "(HappyAbsSyn " . str wild_tyvars . str ")"
> where wild_tyvars = unwords (replicate n_missing_types "_")
>
> -- This decides how to include (if at all) a type signature
> -- See <https://github.com/haskell/happy/issues/94>
> filterTypeSig :: (String -> String) -> String -> String
> filterTypeSig content | n_missing_types == 0 = content
> | otherwise = ifGeGhc710 content
>
> top_opts =
> nowarn_opts
> . (str $ unlines
> [ unwords [ "{-# LANGUAGE", l, "#-}" ] | l <- lang_exts ])
> . partTySigs_opts

%-----------------------------------------------------------------------------
Make the abstract syntax type declaration, of the form:
Expand Down Expand Up @@ -317,7 +301,7 @@ happyMonadReduce to get polymorphic recursion. Sigh.
> . str " -> Happy_IntList -> HappyStk "
> . happyAbsSyn . str " -> "
> . pty . str " " . happyAbsSyn . str "\n"
> in filterTypeSig tysig . mkReduceFun i . str " = "
> in tysig . mkReduceFun i . str " = "
> . str s . strspace . lt' . strspace . showInt adjusted_nt
> . strspace . reductionFun . nl
> . reductionFun . strspace
Expand Down Expand Up @@ -689,7 +673,7 @@ MonadStuff:
> . str " -> Happy_IntList -> HappyStk " . happyAbsSyn
> . str " -> " . ptyAt happyAbsSyn . str ")\n"
> . str "\n"
> in filterTypeSig (happyParseSig . newTokenSig . doActionSig . reduceArrSig)
> in happyParseSig . newTokenSig . doActionSig . reduceArrSig
> . str "happyThen1 :: " . pcont . str " => " . pty
> . str " a -> (a -> " . pty
> . str " b) -> " . pty . str " b\n"
Expand Down
98 changes: 48 additions & 50 deletions lib/frontend/src/Happy/Frontend/AttrGrammar/Parser.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,31 +8,29 @@
{-# LANGUAGE NoStrictData #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE PartialTypeSignatures #-}
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE PartialTypeSignatures #-}
#endif
{-# OPTIONS_GHC -w #-}
module Happy.Frontend.AttrGrammar.Parser (agParser) where
import Happy.Frontend.ParseMonad.Class
import Happy.Frontend.ParseMonad
import Happy.Frontend.AttrGrammar
import qualified Control.Monad as Happy_Prelude
import qualified Data.Bool as Happy_Prelude
import qualified Data.Function as Happy_Prelude
import qualified Data.Maybe as Happy_Prelude
import qualified Data.Int as Happy_Prelude
import qualified Data.String as Happy_Prelude
import qualified Data.List as Happy_Prelude
import qualified Control.Monad as Happy_Prelude
import qualified Text.Show as Happy_Prelude
import qualified GHC.Num as Happy_Prelude
import qualified Data.Maybe as Happy_Prelude
import qualified Data.String as Happy_Prelude
import qualified Data.Tuple as Happy_Prelude
import qualified GHC.Err as Happy_Prelude
import qualified GHC.Num as Happy_Prelude
import qualified Text.Show as Happy_Prelude
import qualified Data.Array as Happy_Data_Array
import qualified Data.Bits as Bits
import qualified GHC.Exts as Happy_GHC_Exts
import Control.Applicative(Applicative(..))
import Control.Monad (ap)

-- parser produced by Happy Version 2.1.1
-- parser produced by Happy Version 2.1.6

newtype HappyAbsSyn = HappyAbsSyn HappyAny
#if __GLASGOW_HASKELL__ >= 607
Expand Down Expand Up @@ -141,7 +139,7 @@ happy_n_starts = 1 :: Happy_Prelude.Int
happyReduce_1 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )
happyReduce_1 = happySpecReduce_1 0# happyReduction_1
happyReduction_1 happy_x_1
= case happyOut6 happy_x_1 of { (HappyWrap6 happy_var_1) ->
= case happyOut6 happy_x_1 of { (HappyWrap6 happy_var_1) ->
happyIn5
(happy_var_1
)}
Expand All @@ -151,16 +149,16 @@ happyReduce_2 = happySpecReduce_3 1# happyReduction_2
happyReduction_2 happy_x_3
happy_x_2
happy_x_1
= case happyOut7 happy_x_1 of { (HappyWrap7 happy_var_1) ->
case happyOut6 happy_x_3 of { (HappyWrap6 happy_var_3) ->
= case happyOut7 happy_x_1 of { (HappyWrap7 happy_var_1) ->
case happyOut6 happy_x_3 of { (HappyWrap6 happy_var_3) ->
happyIn6
(happy_var_1 : happy_var_3
)}}

happyReduce_3 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )
happyReduce_3 = happySpecReduce_1 1# happyReduction_3
happyReduction_3 happy_x_1
= case happyOut7 happy_x_1 of { (HappyWrap7 happy_var_1) ->
= case happyOut7 happy_x_1 of { (HappyWrap7 happy_var_1) ->
happyIn6
(happy_var_1 : []
)}
Expand All @@ -176,8 +174,8 @@ happyReduce_5 = happySpecReduce_3 2# happyReduction_5
happyReduction_5 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_3 of { (HappyWrap8 happy_var_3) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_3 of { (HappyWrap8 happy_var_3) ->
happyIn7
(SelfAssign $ MkAgSelfAssign (selfRefVal happy_var_1) happy_var_3
)}}
Expand All @@ -187,8 +185,8 @@ happyReduce_6 = happySpecReduce_3 2# happyReduction_6
happyReduction_6 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_3 of { (HappyWrap8 happy_var_3) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_3 of { (HappyWrap8 happy_var_3) ->
happyIn7
(SubAssign $ MkAgSubAssign (subRefVal happy_var_1) happy_var_3
)}}
Expand All @@ -198,8 +196,8 @@ happyReduce_7 = happySpecReduce_3 2# happyReduction_7
happyReduction_7 happy_x_3
happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_3 of { (HappyWrap8 happy_var_3) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_3 of { (HappyWrap8 happy_var_3) ->
happyIn7
(RightmostAssign (rightRefVal happy_var_1) happy_var_3
)}}
Expand All @@ -208,7 +206,7 @@ happyReduce_8 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_8 = happySpecReduce_2 2# happyReduction_8
happyReduction_8 happy_x_2
happy_x_1
= case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
= case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
happyIn7
(Conditional $ MkAgConditional happy_var_2
)}
Expand All @@ -220,10 +218,10 @@ happyReduction_9 (happy_x_4 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
case happyOutTok happy_x_3 of { happy_var_3 ->
case happyOut8 happy_x_4 of { (HappyWrap8 happy_var_4) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
case happyOutTok happy_x_3 of { happy_var_3 ->
case happyOut8 happy_x_4 of { (HappyWrap8 happy_var_4) ->
happyIn8
([happy_var_1] ++ happy_var_2 ++ [happy_var_3] ++ happy_var_4
) `HappyStk` happyRest}}}}
Expand All @@ -232,8 +230,8 @@ happyReduce_10 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_10 = happySpecReduce_2 3# happyReduction_10
happyReduction_10 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
happyIn8
(happy_var_1 : happy_var_2
)}}
Expand All @@ -242,8 +240,8 @@ happyReduce_11 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_11 = happySpecReduce_2 3# happyReduction_11
happyReduction_11 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
happyIn8
(happy_var_1 : happy_var_2
)}}
Expand All @@ -252,8 +250,8 @@ happyReduce_12 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_12 = happySpecReduce_2 3# happyReduction_12
happyReduction_12 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
happyIn8
(happy_var_1 : happy_var_2
)}}
Expand All @@ -262,8 +260,8 @@ happyReduce_13 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_13 = happySpecReduce_2 3# happyReduction_13
happyReduction_13 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
happyIn8
(happy_var_1 : happy_var_2
)}}
Expand All @@ -272,8 +270,8 @@ happyReduce_14 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_14 = happySpecReduce_2 3# happyReduction_14
happyReduction_14 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
happyIn8
(happy_var_1 : happy_var_2
)}}
Expand All @@ -291,10 +289,10 @@ happyReduction_16 (happy_x_4 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
case happyOutTok happy_x_3 of { happy_var_3 ->
case happyOut9 happy_x_4 of { (HappyWrap9 happy_var_4) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
case happyOutTok happy_x_3 of { happy_var_3 ->
case happyOut9 happy_x_4 of { (HappyWrap9 happy_var_4) ->
happyIn9
([happy_var_1] ++ happy_var_2 ++ [happy_var_3] ++ happy_var_4
) `HappyStk` happyRest}}}}
Expand All @@ -303,8 +301,8 @@ happyReduce_17 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_17 = happySpecReduce_2 4# happyReduction_17
happyReduction_17 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
happyIn9
(happy_var_1 : happy_var_2
)}}
Expand All @@ -313,8 +311,8 @@ happyReduce_18 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_18 = happySpecReduce_2 4# happyReduction_18
happyReduction_18 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
happyIn9
(happy_var_1 : happy_var_2
)}}
Expand All @@ -323,8 +321,8 @@ happyReduce_19 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_19 = happySpecReduce_2 4# happyReduction_19
happyReduction_19 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
happyIn9
(happy_var_1 : happy_var_2
)}}
Expand All @@ -333,8 +331,8 @@ happyReduce_20 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_20 = happySpecReduce_2 4# happyReduction_20
happyReduction_20 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
happyIn9
(happy_var_1 : happy_var_2
)}}
Expand All @@ -343,8 +341,8 @@ happyReduce_21 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_21 = happySpecReduce_2 4# happyReduction_21
happyReduction_21 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut8 happy_x_2 of { (HappyWrap8 happy_var_2) ->
happyIn9
(happy_var_1 : happy_var_2
)}}
Expand All @@ -353,8 +351,8 @@ happyReduce_22 :: () => Happy_GHC_Exts.Int# -> AgToken -> Happy_GHC_Exts.Int# ->
happyReduce_22 = happySpecReduce_2 4# happyReduction_22
happyReduction_22 happy_x_2
happy_x_1
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
= case happyOutTok happy_x_1 of { happy_var_1 ->
case happyOut9 happy_x_2 of { (HappyWrap9 happy_var_2) ->
happyIn9
(happy_var_1 : happy_var_2
)}}
Expand Down
Loading