GF.Compile.CheckGrammar: discard bad 'lincat C = …' with a warning

e.g. if C is a fun and not a cat in the abstract syntax.
Discarding bad lincats prevents GF from generating malformed PGFs that
are rejected by the C run-time system.
I also added code to reject bad lincats with an error, but I left it
commented out since it seems a bit pedantic compared to GF's otherwise
rather sloppy grammar checking.

1 files changed, 11 insertions, 5 deletions

diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs
index 1348d8e41..5d6922704 100644
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -147,11 +147,17 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
                                            return $ updateTree (c,CncFun (Just linty) d mn mf) js
                              _       -> do checkWarn ("function" <+> c <+> "is not in abstract")
                                            return js
-       CncCat _ _ _ _ _ -> case lookupOrigInfo gr (am,c) of
-                             Ok _ -> return $ updateTree i js
-                             _    -> do checkWarn ("category" <+> c <+> "is not in abstract")
-                                        return js
-       _                -> return $ updateTree i js
+       CncCat {} ->
+         case lookupOrigInfo gr (am,c) of
+           Ok (_,AbsCat _) -> return $ updateTree i js
+           {- -- This might be too pedantic:
+           Ok (_,AbsFun {}) ->
+                   checkError ("lincat:"<+>c<+>"is a fun, not a cat")
+           -}
+           _ -> do checkWarn ("category" <+> c <+> "is not in abstract")
+                   return js
+
+       _ -> return $ updateTree i js
 
 
 -- | General Principle: only Just-values are checked.