Assume GHC as the only compiler to build happy parsers, see #268

packages/backend-glr/data/GLR_Lib.hs

@@ -37,8 +37,8 @@
            )
   where
 
-#if defined(HAPPY_GHC) && !defined(__GLASGOW_HASKELL__)
-#  error `HAPPY_GHC` is defined but this code isn't being built with GHC.
+#if !defined(__GLASGOW_HASKELL__)
+#  error This code isn't being built with GHC.
 #endif
 
 import Data.Char
@@ -48,10 +48,9 @@ import Control.Applicative (Applicative(..))
 import Control.Monad (foldM, ap)
 import Data.Maybe (fromJust)
 import Data.List (insertBy, nub, maximumBy, partition, find, groupBy, delete)
-#if defined(HAPPY_GHC)
+
 import GHC.Prim
 import GHC.Exts
-#endif
 
 #if defined(HAPPY_DEBUG)
 import System.IO
@@ -65,7 +64,6 @@ fakeimport DATA
 
 {- borrowed from GenericTemplate.hs -}
 
-#ifdef HAPPY_GHC
 #define ILIT(n) n#
 #define BANG !
 #define IBOX(n) (I# (n))
@@ -87,21 +85,6 @@ fakeimport DATA
 #define NEGATE(n) (negateInt# (n))
 #define IF_GHC(x) (x)
 
-#else
-
-#define ILIT(n) (n)
-#define BANG
-#define IBOX(n) (n)
-#define FAST_INT Int
-#define ULT(n,m) (n < m)
-#define GTE(n,m) (n >= m)
-#define UEQ(n,m) (n == m)
-#define PLUS(n,m) (n + m)
-#define MINUS(n,m) (n - m)
-#define TIMES(n,m) (n * m)
-#define NEGATE(n) (negate (n))
-#define IF_GHC(x)
-#endif
 
 #if defined(HAPPY_DEBUG)
 #define DEBUG_TRACE(s)    (happyTrace (s) $ return ())

packages/backend-lalr/data/HappyTemplate.hs

@@ -1,40 +1,27 @@
 -- $Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp $
 
-#ifdef HAPPY_GHC
-#  if !defined(__GLASGOW_HASKELL__)
-#    error `HAPPY_GHC` is defined but this code isn't being built with GHC.
-#  endif
-#  define ILIT(n) n#
-#  define IBOX(n) (Happy_GHC_Exts.I# (n))
-#  define FAST_INT Happy_GHC_Exts.Int#
+#if !defined(__GLASGOW_HASKELL__)
+#  error This code isn't being built with GHC.
+#endif
+#define ILIT(n) n#
+#define IBOX(n) (Happy_GHC_Exts.I# (n))
+#define FAST_INT Happy_GHC_Exts.Int#
 -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
-#  if __GLASGOW_HASKELL__ > 706
-#    define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Prelude.Bool)
-#    define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Prelude.Bool)
-#    define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Prelude.Bool)
-#  else
-#    define LT(n,m) (n Happy_GHC_Exts.<# m)
-#    define GTE(n,m) (n Happy_GHC_Exts.>=# m)
-#    define EQ(n,m) (n Happy_GHC_Exts.==# m)
-#  endif
-#  define PLUS(n,m) (n Happy_GHC_Exts.+# m)
-#  define MINUS(n,m) (n Happy_GHC_Exts.-# m)
-#  define TIMES(n,m) (n Happy_GHC_Exts.*# m)
-#  define NEGATE(n) (Happy_GHC_Exts.negateInt# (n))
-#  define IF_GHC(x) (x)
+#if __GLASGOW_HASKELL__ > 706
+#  define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Prelude.Bool)
+#  define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Prelude.Bool)
+#  define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Prelude.Bool)
 #else
-#  define ILIT(n) (n)
-#  define IBOX(n) (n)
-#  define FAST_INT Prelude.Int
-#  define LT(n,m) (n Prelude.< m)
-#  define GTE(n,m) (n Prelude.>= m)
-#  define EQ(n,m) (n Prelude.== m)
-#  define PLUS(n,m) (n Prelude.+ m)
-#  define MINUS(n,m) (n Prelude.- m)
-#  define TIMES(n,m) (n Prelude.* m)
-#  define NEGATE(n) (Prelude.negate (n))
-#  define IF_GHC(x)
+#  define LT(n,m) (n Happy_GHC_Exts.<# m)
+#  define GTE(n,m) (n Happy_GHC_Exts.>=# m)
+#  define EQ(n,m) (n Happy_GHC_Exts.==# m)
 #endif
+#define PLUS(n,m) (n Happy_GHC_Exts.+# m)
+#define MINUS(n,m) (n Happy_GHC_Exts.-# m)
+#define TIMES(n,m) (n Happy_GHC_Exts.*# m)
+#define NEGATE(n) (Happy_GHC_Exts.negateInt# (n))
+#define IF_GHC(x) (x)
+
 
 data Happy_IntList = HappyCons FAST_INT Happy_IntList
 
@@ -47,9 +34,6 @@ data Happy_IntList = HappyCons FAST_INT Happy_IntList
 #define IF_ARRAYS(x) (x)
 
 #if defined(HAPPY_COERCE)
-#  if !defined(HAPPY_GHC)
-#    error `HAPPY_COERCE` requires `HAPPY_GHC`
-#  endif
 #  define GET_ERROR_TOKEN(x)  (case Happy_GHC_Exts.unsafeCoerce# x of { IBOX(i) -> i })
 #  define MK_ERROR_TOKEN(i)   (Happy_GHC_Exts.unsafeCoerce# IBOX(i))
 #  define MK_TOKEN(x)         (happyInTok (x))
@@ -117,33 +101,22 @@ happyDoAction i tk st
           | check     = indexShortOffAddr happyTable off_i
           | Prelude.otherwise = indexShortOffAddr happyDefActions st
 
-#ifdef HAPPY_GHC
 indexShortOffAddr (HappyA# arr) off =
         Happy_GHC_Exts.narrow16Int# i
   where
         i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)
         high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))
         low  = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))
         off' = off Happy_GHC_Exts.*# 2#
-#else
-indexShortOffAddr arr off = arr Happy_Data_Array.! off
-#endif
 
 {-# INLINE happyLt #-}
 happyLt x y = LT(x,y)
 
-#ifdef HAPPY_GHC
 readArrayBit arr bit =
     Bits.testBit IBOX(indexShortOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 4#)) (bit `Prelude.mod` 16)
   where unbox_int (Happy_GHC_Exts.I# x) = x
-#else
-readArrayBit arr bit =
-    Bits.testBit IBOX(indexShortOffAddr arr (bit `Prelude.div` 16)) (bit `Prelude.mod` 16)
-#endif
 
-#ifdef HAPPY_GHC
 data HappyAddr = HappyA# Happy_GHC_Exts.Addr#
-#endif
 
 -----------------------------------------------------------------------------
 -- Shifting a token

packages/backend-lalr/src/Happy/Backend/LALR.hs

@@ -18,11 +18,9 @@ magicFilter magicName = case magicName of
         filter_output [] = []
       in filter_output
 
-importsToInject :: Bool -> Bool -> String
-importsToInject ghc debug = concat ["\n", import_array, import_bits, glaexts_import, debug_imports, applicative_imports]
+importsToInject :: Bool -> String
+importsToInject debug = concat ["\n", import_array, import_bits, import_glaexts, debug_imports, applicative_imports]
     where
-      glaexts_import | ghc       = import_glaexts
-                     | otherwise = ""
       debug_imports  | debug     = import_debug
                      | otherwise = ""
       applicative_imports        = import_applicative
@@ -36,16 +34,13 @@ importsToInject ghc debug = concat ["\n", import_array, import_bits, glaexts_imp
       import_applicative = "import Control.Applicative(Applicative(..))\n" ++
                            "import Control.Monad (ap)\n"
 
-langExtsToInject :: Bool -> [String]
-langExtsToInject ghc
-  | ghc = ["MagicHash", "BangPatterns", "TypeSynonymInstances", "FlexibleInstances"]
-  | otherwise = []
+langExtsToInject :: [String]
+langExtsToInject = ["MagicHash", "BangPatterns", "TypeSynonymInstances", "FlexibleInstances"]
 
-defines :: Bool -> Bool -> Bool -> String
-defines debug ghc coerce = unlines [ "#define " ++ d ++ " 1" | d <- vars_to_define ]
+defines :: Bool -> Bool -> String
+defines debug coerce = unlines [ "#define " ++ d ++ " 1" | d <- vars_to_define ]
   where
   vars_to_define = concat
     [ [ "HAPPY_DEBUG"  | debug ]
-    , [ "HAPPY_GHC"    | ghc ]
     , [ "HAPPY_COERCE" | coerce ]
     ]

packages/backend-lalr/src/Happy/Backend/LALR/ProduceCode.lhs

@@ -35,7 +35,6 @@ Produce the complete output file.
 >               -> Maybe String                 -- module header
 >               -> Maybe String                 -- module trailer
 >               -> Bool                         -- use coercions
->               -> Bool                         -- use ghc extensions
 >               -> Bool                         -- strict parser
 >               -> String
 
@@ -62,7 +61,7 @@ Produce the complete output file.
 >               , error_sig = error_sig'
 >               })
 >               action goto lang_exts module_header module_trailer
->               coerce ghc strict
+>               coerce strict
 >     = ( top_opts
 >       . maybestr module_header . nl
 >       . str comment
@@ -90,22 +89,20 @@ Produce the complete output file.
 >       -- #ifdefs.  For now I'm just disabling all of them.
 >
 >    partTySigs_opts = ifGeGhc710 (str "{-# LANGUAGE PartialTypeSignatures #-}" . nl)
->
->    intMaybeHash | ghc       = str "Happy_GHC_Exts.Int#"
->                 | otherwise = str "Prelude.Int"
->
+
+>    intMaybeHash    = str "Happy_GHC_Exts.Int#"
+
 >    -- Parsing monad and its constraints
 >    pty = str monad_tycon
 >    pcont = str monad_context
 >
 >    -- 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 | ghc = str "#if __GLASGOW_HASKELL__ >= 710" . nl
->                             . content
->                             . str "#endif" . nl
->                       | otherwise = id
->
+>    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 "_")
@@ -505,7 +502,6 @@ machinery to discard states in the parser...
 action array indexed by (terminal * last_state) + state
 
 >    produceActionArray
->       | ghc
 >           = str "happyActOffsets :: HappyAddr\n"
 >           . str "happyActOffsets = HappyA# \"" --"
 >           . str (checkedHexChars min_off act_offs)
@@ -540,64 +536,20 @@ action array indexed by (terminal * last_state) + state
 >           . str (hexChars table)
 >           . str "\"#\n\n" --"
 
->       | otherwise
->           = str "happyActOffsets :: Happy_Data_Array.Array Prelude.Int Prelude.Int\n"
->           . str "happyActOffsets = Happy_Data_Array.listArray (0,"
->               . shows n_states . str ") (["
->           . interleave' "," (map shows act_offs)
->           . str "\n\t])\n\n"
->
->           . str "happyGotoOffsets :: Happy_Data_Array.Array Prelude.Int Prelude.Int\n"
->           . str "happyGotoOffsets = Happy_Data_Array.listArray (0,"
->               . shows n_states . str ") (["
->           . interleave' "," (map shows goto_offs)
->           . str "\n\t])\n\n"
->           
->           . str "happyAdjustOffset :: Prelude.Int -> Prelude.Int\n"
->           . str "happyAdjustOffset = Prelude.id\n\n"
->
->           . str "happyDefActions :: Happy_Data_Array.Array Prelude.Int Prelude.Int\n"
->           . str "happyDefActions = Happy_Data_Array.listArray (0,"
->               . shows n_states . str ") (["
->           . interleave' "," (map shows defaults)
->           . str "\n\t])\n\n"
->
->           . str "happyCheck :: Happy_Data_Array.Array Prelude.Int Prelude.Int\n"
->           . str "happyCheck = Happy_Data_Array.listArray (0,"
->               . shows table_size . str ") (["
->           . interleave' "," (map shows check)
->           . str "\n\t])\n\n"
->
->           . str "happyTable :: Happy_Data_Array.Array Prelude.Int Prelude.Int\n"
->           . str "happyTable = Happy_Data_Array.listArray (0,"
->               . shows table_size . str ") (["
->           . interleave' "," (map shows table)
->           . str "\n\t])\n\n"
 
 >    produceExpListArray
->       | ghc
 >           = str "happyExpList :: HappyAddr\n"
 >           . str "happyExpList = HappyA# \"" --"
 >           . str (hexChars explist)
 >           . str "\"#\n\n" --"
->       | otherwise
->           = str "happyExpList :: Happy_Data_Array.Array Prelude.Int Prelude.Int\n"
->           . str "happyExpList = Happy_Data_Array.listArray (0,"
->               . shows table_size . str ") (["
->           . interleave' "," (map shows explist)
->           . str "\n\t])\n\n"
-
->    (_, last_state) = bounds action
->    n_states = last_state + 1
+
 >    n_terminals = length terms
 >    n_nonterminals = length nonterms - n_starts -- lose %starts
 >
 >    (act_offs,goto_offs,table,defaults,check,explist,min_off)
 >       = mkTables action goto first_nonterm' fst_term
 >               n_terminals n_nonterminals n_starts (bounds token_names')
 >
->    table_size = length table - 1
->
 >    produceReduceArray
 >       = {- str "happyReduceArr :: Array Int a\n" -}
 >         str "happyReduceArr = Happy_Data_Array.array ("
@@ -610,8 +562,7 @@ action array indexed by (terminal * last_state) + state
 
 >    n_rules = length prods - 1 :: Int
 
->    showInt i | ghc       = shows i . showChar '#'
->              | otherwise = shows i
+>    showInt i = shows i . showChar '#'
 
 This lets examples like:
 
@@ -781,7 +732,7 @@ directive determines the API of the provided function.
 >       . str unmonad
 >       . str "happySomeParser where\n"
 >       . str " happySomeParser = happyThen (happyParse "
->       . (if ghc then shows no . str "#" else shows no)
+>       . shows no . str "#"
 >       . maybe_tks
 >       . str ") "
 >       . brack' (if coerce