diff --git a/source/src/BNFC/Backend/Haskell/CFtoPrinter.hs b/source/src/BNFC/Backend/Haskell/CFtoPrinter.hs index 5adaa2c9..3fb48d26 100644 --- a/source/src/BNFC/Backend/Haskell/CFtoPrinter.hs +++ b/source/src/BNFC/Backend/Haskell/CFtoPrinter.hs @@ -68,6 +68,7 @@ prologue tokenText useGadt name absMod cf = map text $ concat , "#endif" ] , [ "" + -- Needed for precedence category lists, e.g. @[Exp2]@: , "{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}" , "" , "-- | Pretty-printer for " ++ takeWhile ('.' /=) name ++ "." @@ -292,7 +293,7 @@ case_fun absMod functor cf cat rules = -- Special printing of lists (precedence changes concrete syntax!) if isList cat then - map mkPrtListCase $ List.sortBy compareRules $ rulesForNormalizedCat cf cat + listCases $ List.sortBy compareRules $ rulesForNormalizedCat cf cat -- Ordinary category else @@ -310,6 +311,16 @@ case_fun absMod functor cf cat rules = ListCat c -> "[" <> type' c <> "]" c@TokenCat{} -> text (qualifiedCat absMod c) c -> text (qualifiedCat absMod c) <> "' a" + listCases [] = [] + listCases rules = concat + [ [ "prt _ [] = concatD []" | not $ any isNilFun rules ] + -- Andreas, 2021-09-22, issue #386 + -- If the list is @nonempty@ according to the grammar, still add a nil case. + -- In the AST it is simply a list, and the AST could be created + -- by other means than by parsing. + , map mkPrtListCase rules + ] + -- | When writing the Print instance for a category (in case_fun), we have -- a different case for each constructor for this category. diff --git a/source/src/BNFC/Backend/OCaml/CFtoOCamlPrinter.hs b/source/src/BNFC/Backend/OCaml/CFtoOCamlPrinter.hs index 177e6853..02bc1ffb 100644 --- a/source/src/BNFC/Backend/OCaml/CFtoOCamlPrinter.hs +++ b/source/src/BNFC/Backend/OCaml/CFtoOCamlPrinter.hs @@ -174,9 +174,10 @@ case_fun absMod cat xs = unlines [ -- mkListRule rs = unlines $ ("and prt" ++ fixTypeUpper cat ++ "ListBNFC" +++ "_ es : doc = match es with"):rs ifList :: CF -> Cat -> String -ifList cf cat = render $ - case cases of - [] -> empty +ifList cf cat + | null rules = "" + | otherwise = render $ case cases of + [] -> empty -- IMPOSSIBLE CASE when (rules /= []) first:rest -> vcat [ "and prt" <> text (fixTypeUpper cat) <> "ListBNFC i es : doc = match (i, es) with" , nest 4 first @@ -184,8 +185,14 @@ ifList cf cat = render $ ] where rules = sortBy compareRules $ rulesForNormalizedCat cf (ListCat cat) - cases = [ d | r <- rules, let d = mkPrtListCase r, not (isEmpty d) ] - + cases = concat + [ [ "(_,[]) -> (concatD [])" | not $ any isNilFun rules ] + -- Andreas, 2021-09-22, issue #386 + -- If the list is @nonempty@ according to the grammar, still add a nil case. + -- In the AST it is simply a list, and the AST could be created + -- by other means than by parsing. + , [ d | r <- rules, let d = mkPrtListCase r, not (isEmpty d) ] + ] -- | Pattern match on the list constructor and the coercion level --