Skip to content

Commit

Permalink
Do not use Prelude; concoct our own Happy_Prelude alias (#325)
Browse files Browse the repository at this point in the history
This is in order to undo a breaking change caused by users
writing `import Prelude hiding (null)`.

Fixes #325.
  • Loading branch information
sgraf812 committed Oct 27, 2024
1 parent 68104b1 commit b0fc710
Show file tree
Hide file tree
Showing 12 changed files with 252 additions and 220 deletions.
5 changes: 5 additions & 0 deletions ChangeLog.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,10 @@
# Revision history for Happy

## 2.1.2

Fix a breaking change (#325) introduced by the previous fix for #131.
Prelude is no longer used by Happy.

## 2.1.1

This release fixes two breaking changes:
Expand Down
3 changes: 0 additions & 3 deletions doc/syntax.rst
Original file line number Diff line number Diff line change
Expand Up @@ -66,9 +66,6 @@ This section is optional, but if included takes the following form:

The Haskell module header contains the module name, exports, and imports.
No other code is allowed in the header—this is because Happy may need to include its own ``import`` statements directly after the user defined header.
Do note that Happy relies on ``Prelude`` from ``base`` being in scope qualified.
Users who hide functions from ``Prelude`` or redefine it to use a custom prelude
must also ``import qualified "base" Prelude`` for Happy.

.. _sec-directives:

Expand Down
4 changes: 2 additions & 2 deletions happy.cabal
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: happy
version: 2.1.1
version: 2.1.2
license: BSD2
license-file: LICENSE
copyright: (c) Andy Gill, Simon Marlow
Expand Down Expand Up @@ -139,7 +139,7 @@ executable happy
array,
containers >= 0.4.2,
mtl >= 2.2.1,
happy-lib == 2.1.1
happy-lib == 2.1.2

default-language: Haskell98
default-extensions: CPP, MagicHash, FlexibleContexts, NamedFieldPuns
Expand Down
16 changes: 14 additions & 2 deletions lib/backend-lalr/src/Happy/Backend/LALR.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ magicFilter magicName = case magicName of
in filter_output

importsToInject :: Bool -> String
importsToInject debug = concat ["\n", import_array, import_list, import_bits, import_glaexts, debug_imports, applicative_imports]
importsToInject debug = concat ["\n", import_prelude, import_array, import_bits, import_glaexts, debug_imports, applicative_imports]
where
debug_imports | debug = import_debug
| otherwise = ""
Expand All @@ -28,13 +28,25 @@ importsToInject debug = concat ["\n", import_array, import_list, import_bits, im
import_glaexts = "import qualified GHC.Exts as Happy_GHC_Exts\n"
_import_ghcstack = "import qualified GHC.Stack as Happy_GHC_Stack\n"
import_array = "import qualified Data.Array as Happy_Data_Array\n"
import_list = "import qualified Data.List as Happy_Data_List\n"
import_bits = "import qualified Data.Bits as Bits\n"
import_debug = "import qualified System.IO as Happy_System_IO\n" ++
"import qualified System.IO.Unsafe as Happy_System_IO_Unsafe\n" ++
"import qualified Debug.Trace as Happy_Debug_Trace\n"
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.List"
, "Control.Monad"
, "Text.Show"
, "GHC.Num"
, "GHC.Err"
]

langExtsToInject :: [String]
langExtsToInject = ["MagicHash", "BangPatterns", "TypeSynonymInstances", "FlexibleInstances", "PatternGuards", "NoStrictData", "UnboxedTuples", "PartialTypeSignatures"]
Expand Down
38 changes: 19 additions & 19 deletions lib/backend-lalr/src/Happy/Backend/LALR/ProduceCode.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -218,7 +218,7 @@ example where this matters.
> | otherwise
> = str "data HappyAbsSyn " . str_tyvars
> . str "\n" . indent . str "= HappyTerminal " . token
> . str "\n" . indent . str "| HappyErrorToken Prelude.Int\n"
> . str "\n" . indent . str "| HappyErrorToken Happy_Prelude.Int\n"
> . interleave "\n"
> [ str "" . indent . str "| " . makeAbsSynCon n . strspace . typeParam n ty
> | (n, ty) <- assocs nt_types,
Expand Down Expand Up @@ -381,7 +381,7 @@ The token conversion function.
> . str "\\i tk -> " . doAction . str " sts stk)\n"
> . str "\n"
> . str "happyReport " . eofTok . str " tk explist resume tks = happyReport' tks explist resume\n"
> . str "happyReport _ tk explist resume tks = happyReport' (tk:tks) explist (\\tks -> resume (Prelude.tail tks))\n"
> . str "happyReport _ tk explist resume tks = happyReport' (tk:tks) explist (\\tks -> resume (Happy_Prelude.tail tks))\n"
> -- when the token is EOF, tk == _|_ (notHappyAtAll)
> -- so we must not pass it to happyReport'
> . str "\n";
Expand Down Expand Up @@ -488,9 +488,9 @@ machinery to discard states in the parser...
> . produceReduceArray
> . produceRuleArray
> . produceCatchStates
> . str "happy_n_terms = " . shows n_terminals . str " :: Prelude.Int\n"
> . str "happy_n_nonterms = " . shows n_nonterminals . str " :: Prelude.Int\n\n"
> . str "happy_n_starts = " . shows n_starts . str " :: Prelude.Int\n\n"
> . str "happy_n_terms = " . shows n_terminals . str " :: Happy_Prelude.Int\n"
> . str "happy_n_nonterms = " . shows n_nonterminals . str " :: Happy_Prelude.Int\n\n"
> . str "happy_n_starts = " . shows n_starts . str " :: Happy_Prelude.Int\n\n"
>
> produceTokToStringList
> = str "{-# NOINLINE happyTokenStrings #-}\n"
Expand Down Expand Up @@ -553,7 +553,7 @@ action array indexed by (terminal * last_state) + state
> n_rules = length prods - 1 :: Int
>
> produceCatchStates
> = str "happyCatchStates :: [Prelude.Int]\n"
> = str "happyCatchStates :: [Happy_Prelude.Int]\n"
> . str "happyCatchStates = " . shows catch_states . str "\n\n"

> showInt i = shows i . showChar '#'
Expand Down Expand Up @@ -599,12 +599,12 @@ outlaw them inside { }
> str "newtype HappyIdentity a = HappyIdentity a\n"
> . str "happyIdentity = HappyIdentity\n"
> . str "happyRunIdentity (HappyIdentity a) = a\n\n"
> . str "instance Prelude.Functor HappyIdentity where\n"
> . str "instance Happy_Prelude.Functor HappyIdentity where\n"
> . str " fmap f (HappyIdentity a) = HappyIdentity (f a)\n\n"
> . str "instance Applicative HappyIdentity where\n"
> . str " pure = HappyIdentity\n"
> . str " (<*>) = ap\n"
> . str "instance Prelude.Monad HappyIdentity where\n"
> . str "instance Happy_Prelude.Monad HappyIdentity where\n"
> . str " return = pure\n"
> . str " (HappyIdentity p) >>= q = q p\n\n"

Expand Down Expand Up @@ -652,7 +652,7 @@ MonadStuff:
> . str " a\n"
> . str "happyReport' :: " . pcont . str " => "
> . str "[" . token . str "] -> "
> . str "[Prelude.String] -> ("
> . str "[Happy_Prelude.String] -> ("
> . str "[" . token . str "] -> "
> . ptyAt (str "a") . str ") -> "
> . ptyAt (str "a")
Expand Down Expand Up @@ -684,7 +684,7 @@ MonadStuff:
> . str "\n"
> reduceArrSig =
> str "happyReduceArr :: " . pcont
> . str " => Happy_Data_Array.Array Prelude.Int (" . intMaybeHash
> . str " => Happy_Data_Array.Array Happy_Prelude.Int (" . intMaybeHash
> . str " -> " . str token_type' . str " -> " . intMaybeHash
> . str " -> Happy_IntList -> HappyStk " . happyAbsSyn
> . str " -> " . ptyAt happyAbsSyn . str ")\n"
Expand All @@ -699,7 +699,7 @@ MonadStuff:
> . str "happyReturn1 = happyReturn\n"
> . str "happyReport' :: " . pcont . str " => "
> . token . str " -> "
> . str "[Prelude.String] -> "
> . str "[Happy_Prelude.String] -> "
> . ptyAt (str "a") . str " -> "
> . ptyAt (str "a")
> . str "\n"
Expand All @@ -726,7 +726,7 @@ have a special code path for `OldExpected`.
> callReportError = -- this one wraps around report_error_handler to expose a unified interface
> str "(\\tokens expected resume -> " .
> (if use_monad then str ""
> else str "HappyIdentity Prelude.$ ") .
> else str "HappyIdentity Happy_Prelude.$ ") .
> report_error_handler .
> (case error_expected' of
> OldExpected -> str " (tokens, expected)" -- back-compat for %errorhandlertype
Expand All @@ -744,7 +744,7 @@ have a special code path for `OldExpected`.
> ResumptiveErrorHandler _abort report -> brack report
> abort_handler = case error_handler' of
> ResumptiveErrorHandler abort _report -> abort
> _ -> "Prelude.error \"Called abort handler in non-resumptive parser\""
> _ -> "Happy_Prelude.error \"Called abort handler in non-resumptive parser\""

> reduceArrElem n
> = str "" . indent . str "(" . shows n . str " , "
Expand Down Expand Up @@ -799,21 +799,21 @@ have a special code path for `OldExpected`.
> . str "do { "
> . str "f <- do_" . str name . str "; "
> . str "let { (conds,attrs) = f happyEmptyAttrs } in do { "
> . str "Prelude.sequence_ conds; "
> . str "Prelude.return (". str defaultAttr . str " attrs) }}"
> . str "Happy_Prelude.sequence_ conds; "
> . str "Happy_Prelude.return (". str defaultAttr . str " attrs) }}"
> monadAE name
> = str name . str " toks = "
> . str "do { "
> . str "f <- do_" . str name . str " toks; "
> . str "let { (conds,attrs) = f happyEmptyAttrs } in do { "
> . str "Prelude.sequence_ conds; "
> . str "Prelude.return (". str defaultAttr . str " attrs) }}"
> . str "Happy_Prelude.sequence_ conds; "
> . str "Happy_Prelude.return (". str defaultAttr . str " attrs) }}"
> regularAE name
> = str name . str " toks = "
> . str "let { "
> . str "f = do_" . str name . str " toks; "
> . str "(conds,attrs) = f happyEmptyAttrs; "
> . str "x = Prelude.foldr Prelude.seq attrs conds; "
> . str "x = Happy_Prelude.foldr Happy_GHC_Exts.seq attrs conds; "
> . str "} in (". str defaultAttr . str " x)"

----------------------------------------------------------------------------
Expand All @@ -830,7 +830,7 @@ have a special code path for `OldExpected`.
> where attributes' = foldl1 (\x y -> x . str ", " . y) $ map formatAttribute attrs
> formatAttribute (ident,typ) = str ident . str " :: " . str typ
> attrsErrors = foldl1 (\x y -> x . str ", " . y) $ map attrError attrs
> attrError (ident,_) = str ident . str " = Prelude.error \"invalid reference to attribute '" . str ident . str "'\""
> attrError (ident,_) = str ident . str " = Happy_Prelude.error \"invalid reference to attribute '" . str ident . str "'\""
> attrHeader =
> case attributeType of
> [] -> str "HappyAttributes"
Expand Down
Loading

0 comments on commit b0fc710

Please sign in to comment.