Move contents of happy-codegen-common into happy-grammar; delete (#…

…286)

I also renamed `CommonOptions` into `Pragmas`, because it captures the
information set by pragmas of a .y-file.

Fixes #286.

.github/workflows/haskell-ci.yml

@@ -181,7 +181,6 @@ jobs:
           touch cabal.project
           echo "packages: $GITHUB_WORKSPACE/source/packages/tabular" >> cabal.project
           echo "packages: $GITHUB_WORKSPACE/source/packages/frontend" >> cabal.project
-          echo "packages: $GITHUB_WORKSPACE/source/packages/codegen-common" >> cabal.project
           echo "packages: $GITHUB_WORKSPACE/source/packages/backend-lalr" >> cabal.project
           echo "packages: $GITHUB_WORKSPACE/source/packages/backend-glr" >> cabal.project
           echo "packages: $GITHUB_WORKSPACE/source/packages/grammar" >> cabal.project
@@ -201,8 +200,6 @@ jobs:
           echo "PKGDIR_happy_tabular=${PKGDIR_happy_tabular}" >> "$GITHUB_ENV"
           PKGDIR_happy_frontend="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/happy-frontend-[0-9.]*')"
           echo "PKGDIR_happy_frontend=${PKGDIR_happy_frontend}" >> "$GITHUB_ENV"
-          PKGDIR_happy_codegen_common="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/happy-codegen-common-[0-9.]*')"
-          echo "PKGDIR_happy_codegen_common=${PKGDIR_happy_codegen_common}" >> "$GITHUB_ENV"
           PKGDIR_happy_backend_lalr="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/happy-backend-lalr-[0-9.]*')"
           echo "PKGDIR_happy_backend_lalr=${PKGDIR_happy_backend_lalr}" >> "$GITHUB_ENV"
           PKGDIR_happy_backend_glr="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/happy-backend-glr-[0-9.]*')"
@@ -216,7 +213,6 @@ jobs:
           touch cabal.project.local
           echo "packages: ${PKGDIR_happy_tabular}" >> cabal.project
           echo "packages: ${PKGDIR_happy_frontend}" >> cabal.project
-          echo "packages: ${PKGDIR_happy_codegen_common}" >> cabal.project
           echo "packages: ${PKGDIR_happy_backend_lalr}" >> cabal.project
           echo "packages: ${PKGDIR_happy_backend_glr}" >> cabal.project
           echo "packages: ${PKGDIR_happy_grammar}" >> cabal.project
@@ -225,8 +221,6 @@ jobs:
           if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "    ghc-options: -Werror=missing-methods" >> cabal.project ; fi
           if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package happy-frontend" >> cabal.project ; fi
           if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "    ghc-options: -Werror=missing-methods" >> cabal.project ; fi
-          if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package happy-codegen-common" >> cabal.project ; fi
-          if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "    ghc-options: -Werror=missing-methods" >> cabal.project ; fi
           if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package happy-backend-lalr" >> cabal.project ; fi
           if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "    ghc-options: -Werror=missing-methods" >> cabal.project ; fi
           if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package happy-backend-glr" >> cabal.project ; fi
@@ -237,7 +231,7 @@ jobs:
           if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "    ghc-options: -Werror=missing-methods" >> cabal.project ; fi
           cat >> cabal.project <<EOF
           EOF
-          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(containers|happy|happy-backend-glr|happy-backend-lalr|happy-codegen-common|happy-frontend|happy-grammar|happy-tabular|mtl|transformers)$/; }' >> cabal.project.local
+          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(containers|happy|happy-backend-glr|happy-backend-lalr|happy-frontend|happy-grammar|happy-tabular|mtl|transformers)$/; }' >> cabal.project.local
           cat cabal.project
           cat cabal.project.local
       - name: dump install plan
@@ -269,8 +263,6 @@ jobs:
           ${CABAL} -vnormal check
           cd ${PKGDIR_happy_frontend} || false
           ${CABAL} -vnormal check
-          cd ${PKGDIR_happy_codegen_common} || false
-          ${CABAL} -vnormal check
           cd ${PKGDIR_happy_backend_lalr} || false
           ${CABAL} -vnormal check
           cd ${PKGDIR_happy_backend_glr} || false

happy.cabal

@@ -144,7 +144,6 @@ executable happy
                  array,
                  containers >= 0.4.2,
                  mtl >= 2.2.1,
-                 happy-codegen-common == 2.0,
                  happy-grammar == 2.0,
                  happy-tabular == 2.0,
                  happy-frontend == 2.0,

packages/backend-glr/happy-backend-glr.cabal

@@ -51,7 +51,6 @@ library
                        Happy.Backend.GLR.ProduceCode
   build-depends:       base < 5,
                        array,
-                       happy-codegen-common == 2.0,
                        happy-grammar == 2.0,
                        happy-tabular == 2.0
 

packages/backend-glr/src/Happy/Backend/GLR/ProduceCode.lhs

@@ -18,7 +18,6 @@ This module is designed as an extension to the Haskell parser generator Happy.
 >                       ) where
 
 > import Paths_happy_backend_glr ( version )
-> import Happy.CodeGen.Common.Options
 > import Happy.Grammar
 > import Happy.Tabular.LALR
 > import Data.Array ( Array, (!), array, assocs )
@@ -91,11 +90,11 @@ the driver and data strs (large template).
 >        -> Maybe String  -- User-defined stuff (token DT, lexer etc.)
 >        -> (DebugMode,Options)       -- selecting code-gen style
 >        -> Grammar       -- Happy Grammar
->        -> CommonOptions -- Happy.CodeGen.Common.Options
+>        -> Pragmas       -- Pragmas in the .y-file
 >        -> (String       -- data
 >           ,String)      -- parser
 >
-> produceGLRParser (base, lib) basename tables start header trailer (debug,options) g common_options
+> produceGLRParser (base, lib) basename tables start header trailer (debug,options) g pragmas
 >  = ( content base $ ""
 >    , lib_content lib
 >    )
@@ -144,7 +143,7 @@ Extract the string that comes before the module declaration...
 
 >       return $ before ++ "\n" ++ after
 
->   (sem_def, sem_info) = mkGSemType options g common_options
+>   (sem_def, sem_info) = mkGSemType options g pragmas
 >   table_text = mkTbls tables sem_info (ghcExts_opt) g
 
 >   header_parts = fmap (span (\x -> take 3 (dropWhile isSpace x) == "{-#")
@@ -189,15 +188,15 @@ Extract the string that comes before the module declaration...
 >       . nl
 >       . nl
 
->     . mkGSymbols g common_options .nl
+>     . mkGSymbols g pragmas .nl
 >     . nl
 >     . sem_def                     .nl
 >     . nl
->     . mkSemObjects  options (monad_sub common_options) sem_info  .nl
+>     . mkSemObjects  options (monad_sub pragmas) sem_info  .nl
 >     . nl
->     . mkDecodeUtils options (monad_sub common_options) sem_info  .nl
+>     . mkDecodeUtils options (monad_sub pragmas) sem_info  .nl
 >     . nl
->     . user_def_token_code (token_type common_options)            .nl
+>     . user_def_token_code (token_type pragmas)            .nl
 >     . nl
 >     . table_text
 
@@ -211,7 +210,7 @@ Extract the string that comes before the module declaration...
 >                  [ "{-# LANGUAGE " ++ l ++ " #-}\n" | l <- lang_exts ]
 >              , comment "driver" ++ "\n"
 >              , "module " ++ mod_name ++ "("
->              , case lexer common_options of
+>              , case lexer pragmas of
 >                  Nothing     -> ""
 >                  Just (lf,_) -> "  " ++ lf ++ ","
 >              , "  " ++ start
@@ -373,8 +372,8 @@ Do the same with the Happy goto table.
 %-----------------------------------------------------------------------------
 Create the 'GSymbol' ADT for the symbols in the grammar
 
-> mkGSymbols :: Grammar -> CommonOptions -> ShowS
-> mkGSymbols g common_options
+> mkGSymbols :: Grammar -> Pragmas -> ShowS
+> mkGSymbols g pragmas
 >  = str dec
 >  . str eof
 >  . str tok
@@ -386,7 +385,7 @@ Create the 'GSymbol' ADT for the symbols in the grammar
 >  where
 >   dec  = "data GSymbol"
 >   eof  = " = HappyEOF"
->   tok  = " | HappyTok {-!Int-} (" ++ token_type common_options ++ ")"
+>   tok  = " | HappyTok {-!Int-} (" ++ token_type pragmas ++ ")"
 >   der  = "   deriving (Show,Eq,Ord)"
 >   syms = [ token_names g ! i | i <- user_non_terminals g ]
 
@@ -424,17 +423,17 @@ Creating a type for storing semantic rules
 > type SemInfo
 >  = [(String, String, [Int], [((Int,Int), ([(Int,String)],String), [Int])])]
 
-> mkGSemType :: Options -> Grammar -> CommonOptions -> (ShowS, SemInfo)
-> mkGSemType (TreeDecode,_,_) g common_options
+> mkGSemType :: Options -> Grammar -> Pragmas -> (ShowS, SemInfo)
+> mkGSemType (TreeDecode,_,_) g pragmas
 >  = (def, map snd syms)
 >  where
->   mtype s = case monad_sub common_options of
+>   mtype s = case monad_sub pragmas of
 >               Nothing       -> s
 >               Just (ty,_,_) -> ty ++ ' ' : brack s ""
 
 >   def  = str "data GSem" . nl
 >        . str " = NoSem"  . nl
->        . str (" | SemTok (" ++  token_type common_options ++ ")") . nl
+>        . str (" | SemTok (" ++  token_type pragmas ++ ")") . nl
 >        . interleave "\n" [ str " | " . str sym . str " "
 >                          | sym <- map fst syms ]
 >        . str "instance Show GSem where" . nl
@@ -472,18 +471,18 @@ Creating a type for storing semantic rules
 >                                    , ts !! k == t ]
 >          ]
 
->   typeOf n | n `elem` terminals g = token_type common_options
+>   typeOf n | n `elem` terminals g = token_type pragmas
 >            | otherwise            = case types g ! n of
 >                                       Nothing -> "()"         -- default
 >                                       Just t  -> t
 
 > -- NB expects that such labels are Showable
-> mkGSemType (LabelDecode,_,_) g common_options
+> mkGSemType (LabelDecode,_,_) g pragmas
 >  = (def, map snd syms)
 >  where
 >   def = str "data GSem" . nl
 >       . str " = NoSem"  . nl
->       . str (" | SemTok (" ++  token_type common_options ++ ")")
+>       . str (" | SemTok (" ++  token_type pragmas ++ ")")
 >       . interleave "\n" [ str " | "  . str sym . str " "
 >                         | sym <- map fst syms ]
 >       . str "   deriving (Show)" . nl
@@ -672,9 +671,9 @@ only unpacked when needed. Using classes here to manage the unpacking.
 This selects the info used for monadic parser generation
 
 > type MonadInfo = Maybe (String,String,String)
-> monad_sub :: CommonOptions -> MonadInfo
-> monad_sub common_options
->  = case monad common_options of
+> monad_sub :: Pragmas -> MonadInfo
+> monad_sub pragmas
+>  = case monad pragmas of
 >      (True, _, ty,bd,ret) -> Just (ty,bd,ret)
 >      _                    -> Nothing
 >    -- TMP: only use monad info if it was user-declared, and ignore ctxt

packages/backend-lalr/happy-backend-lalr.cabal

@@ -50,7 +50,6 @@ library
                        Happy.Backend.LALR.ProduceCode
   build-depends:       base < 5,
                        array,
-                       happy-codegen-common == 2.0,
                        happy-grammar == 2.0,
                        happy-tabular == 2.0
 

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

@@ -8,7 +8,6 @@ The code generator.
 
 > import Paths_happy_backend_lalr  ( version )
 > import Data.Version              ( showVersion )
-> import Happy.CodeGen.Common.Options
 > import Happy.Grammar
 > import Happy.Tabular.LALR
 
@@ -30,7 +29,7 @@ The code generator.
 Produce the complete output file.
 
 > produceParser :: Grammar                      -- grammar info
->               -> CommonOptions                -- common codegen options
+>               -> Pragmas                      -- pragmas supplied in the .y-file
 >               -> ActionTable                  -- action table
 >               -> GotoTable                    -- goto table
 >               -> [String]                     -- language extensions
@@ -54,7 +53,7 @@ Produce the complete output file.
 >               , attributetype = attributetype'
 >               , attributes = attributes'
 >               })
->               (CommonOptions
+>               (Pragmas
 >               { lexer = lexer'
 >               , imported_identity = imported_identity'
 >               , monad = (use_monad,monad_context,monad_tycon,monad_then,monad_return)

packages/frontend/happy-frontend.cabal

@@ -51,7 +51,6 @@ library
                        containers >= 0.4.2,
                        transformers >= 0.5.6.2,
                        mtl >= 2.2.2,
-                       happy-codegen-common == 2.0,
                        happy-grammar == 2.0
 
   default-language:    Haskell98

packages/frontend/src/Happy/Frontend/AbsSyn.lhs

@@ -16,7 +16,7 @@ Here is the abstract syntax of the language we parse.
 >       Rule(..), Prod(..), Term(..), Prec(..)
 >  ) where
 
-> import Happy.CodeGen.Common.Options (ErrorHandlerType(..))
+> import Happy.Grammar (ErrorHandlerType(..))
 
 > data BookendedAbsSyn
 >     = BookendedAbsSyn

packages/frontend/src/Happy/Frontend/Mangler.lhs

@@ -8,7 +8,6 @@ Mangler converts AbsSyn to Grammar
 
 > module Happy.Frontend.Mangler (mangler) where
 
-> import Happy.CodeGen.Common.Options
 > import Happy.Grammar
 > import Happy.Frontend.AbsSyn
 > import Happy.Frontend.Mangler.Monad
@@ -29,13 +28,13 @@ Mangler converts AbsSyn to Grammar
 
 This bit is a real mess, mainly because of the error message support.
 
-> mangler :: FilePath -> AbsSyn -> Either [ErrMsg] (Grammar, CommonOptions)
+> mangler :: FilePath -> AbsSyn -> Either [ErrMsg] (Grammar, Pragmas)
 > mangler file abssyn
 >   | null errs = Right gd
 >   | otherwise = Left errs
 >   where (gd, errs) = runWriter (manglerM file abssyn)
 
-> manglerM :: FilePath -> AbsSyn -> M (Grammar, CommonOptions)
+> manglerM :: FilePath -> AbsSyn -> M (Grammar, Pragmas)
 > manglerM file (AbsSyn dirs rules') =
 >   -- add filename to all error messages
 >   mapWriter (\(a,e) -> (a, map (\s -> file ++ ": " ++ s) e)) $ do
@@ -239,7 +238,7 @@ Get the token specs in terms of Names.
 >               attributes        = attrs,
 >               attributetype     = attrType
 >       },
->       CommonOptions {
+>       Pragmas {
 >               imported_identity                 = getImportedIdentity dirs,
 >               monad             = getMonad dirs,
 >               lexer             = getLexer dirs,