diff --git a/source/CHANGELOG.md b/source/CHANGELOG.md index 9b6310bc..57f6af3f 100644 --- a/source/CHANGELOG.md +++ b/source/CHANGELOG.md @@ -3,6 +3,7 @@ Andreas Abel * Haskell: the `--functor` option now produces position-annotated ASTs [#176,#327]. Thanks @Commelina! +* Haskell: fix generated `Makefile` and test parser for `--glr` mode [#340] * Haskell(/GADT): generated modules import `Prelude` explicitly, compatible with `{-# LANGUAGE NoImplicitPrelude #-}` * Haskell: generated code is warning free (and mostly that for `--xml[t]`) [#331] * Haskell: generated printer more robust wrt. identifier clashes [#337] diff --git a/source/src/BNFC/Backend/Haskell.hs b/source/src/BNFC/Backend/Haskell.hs index 1875fb33..075e5065 100644 --- a/source/src/BNFC/Backend/Haskell.hs +++ b/source/src/BNFC/Backend/Haskell.hs @@ -163,13 +163,20 @@ distCleanRule opts makeFile = Makefile.mkRule "distclean" ["clean"] $ alsoBak :: FilePath -> [FilePath] alsoBak s = [ s, s <.> "bak" ] -makefileHeader :: Doc -makefileHeader = vcat +makefileHeader :: Options -> Doc +makefileHeader Options{ glr } = vcat [ "# Makefile generated by BNFC." , "" , "GHC = ghc" , "HAPPY = happy" - , "HAPPY_OPTS = --ghc --coerce --array --info" + , hsep $ concat + [ [ "HAPPY_OPTS = --array --info" ] + , if glr == GLR + then [ "--glr --decode" ] + else [ "--ghc --coerce" ] + -- These options currently (2021-02-14) do not work with GLR mode + -- see https://github.com/simonmar/happy/issues/173 + ] , "ALEX = alex" , "ALEX_OPTS = --ghc" , "" @@ -182,7 +189,7 @@ makefile -> String -- ^ Filename of the makefile. -> Doc -- ^ Content of the makefile. makefile opts makeFile = vcat - [ makefileHeader + [ makefileHeader opts , phonyRule , defaultRule , vcat [ "# Rules for building the parser." , "" ] @@ -234,13 +241,7 @@ makefile opts makeFile = vcat -- | Rule to invoke @happy@. happyRule :: Doc - happyRule = Makefile.mkRule "%.hs" [ "%.y" ] [ recipe ] - where - recipe = unwords . concat $ - [ [ "${HAPPY}", "${HAPPY_OPTS}" ] - , when (glr opts == GLR) $ [ "--glr", "--decode" ] - , [ "$<" ] - ] + happyRule = Makefile.mkRule "%.hs" [ "%.y" ] [ "${HAPPY} ${HAPPY_OPTS} $<" ] -- | Rule to invoke @alex@. alexRule :: Doc @@ -295,6 +296,7 @@ testfile opts cf = unlines $ concat $ , " , FilePath" ] , [ " , getContents, readFile" | tokenText opts == StringToken ] + , [ " , (.), error, flip, map, replicate, sequence_, zip" | use_glr ] , [ " )" ] , case tokenText opts of StringToken -> [] @@ -312,10 +314,10 @@ testfile opts cf = unlines $ concat $ , "" ] , table "" $ concat - [ [ [ "import " , absFileM opts , " ()" ] ] + [ [ [ "import " , absFileM opts , " (" ++ if_glr impTopCat ++ ")" ] ] , [ [ "import " , layoutFileM opts , " ( resolveLayout )" ] | lay ] , [ [ "import " , alexFileM opts , " ( Token )" ] - , [ "import " , happyFileM opts , " ( " ++ firstParser ++ ", myLexer )" ] + , [ "import " , happyFileM opts , " ( " ++ impParser ++ ", myLexer" ++ impParGLR ++ ")" ] , [ "import " , printerFileM opts , " ( Print, printTree )" ] , [ "import " , templateFileM opts , " ()" ] ] @@ -364,7 +366,7 @@ testfile opts cf = unlines $ concat $ , " fs -> mapM_ (runFile 2 " ++ firstParser ++ ") fs" , "" ] - , when use_glr $ + , if_glr $ [ "the_parser :: ParseFun " ++ show topType , "the_parser = lift_parser " ++ render (parserName topType) , "" @@ -376,9 +378,13 @@ testfile opts cf = unlines $ concat $ use_xml = xml opts > 0 xpr = if use_xml then "XPrint a, " else "" use_glr = glr opts == GLR - if_glr s = if use_glr then s else "" - firstParser = if use_glr then "the_parser" else render (parserName topType) + if_glr :: Monoid a => a -> a + if_glr = when use_glr + firstParser = if use_glr then "the_parser" else impParser + impParser = render (parserName topType) topType = firstEntry cf + impTopCat = unwords [ "", identCat topType, "" ] + impParGLR = if_glr ", GLRResult(..), Branch, ForestId, TreeDecode(..), decode" myLLexer atom | lay = unwords [ "resolveLayout True $ myLexer", atom] | True = unwords [ "myLexer", atom]