Add a safeguard to Core Lint
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>
Tue, 9 Apr 2019 13:09:29 +0000 (15:09 +0200)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Sun, 14 Apr 2019 12:49:23 +0000 (08:49 -0400)
Lint returns a pair (Maybe a, WarnsAndErrs). The Maybe monad
allows to handle an unrecoverable failure.
In case of such a failure, the error should be added to the second
component of the pair. If this is not done, Lint will silently
accept bad programs. This situation actually happened during
development of linear types. This adds a safeguard.

compiler/coreSyn/CoreLint.hs

index 8c85685..2210716 100644 (file)
@@ -2080,7 +2080,7 @@ defaultLintFlags = LF { lf_check_global_ids = False
 newtype LintM a =
    LintM { unLintM ::
             LintEnv ->
-            WarnsAndErrs ->           -- Error and warning messages so far
+            WarnsAndErrs ->           -- Warning and error messages so far
             (Maybe a, WarnsAndErrs) } -- Result and messages (if any)
 
 type WarnsAndErrs = (Bag MsgDoc, Bag MsgDoc)
@@ -2189,10 +2189,13 @@ data LintLocInfo
   | InCo   Coercion     -- Inside a coercion
 
 initL :: DynFlags -> LintFlags -> InScopeSet
-       -> LintM a -> WarnsAndErrs    -- Errors and warnings
+       -> LintM a -> WarnsAndErrs    -- Warnings and errors
 initL dflags flags in_scope m
   = case unLintM m env (emptyBag, emptyBag) of
-      (_, errs) -> errs
+      (Just _, errs) -> errs
+      (Nothing, errs@(_, e)) | not (isEmptyBag e) -> errs
+                             | otherwise -> pprPanic ("Bug in Lint: a failure occurred " ++
+                                                      "without reporting an error message") empty
   where
     env = LE { le_flags = flags
              , le_subst = mkEmptyTCvSubst in_scope