[GHC] #14777: panic when using a function defined in terms of `error`

[GHC]

#14777: panic when using a function defined in terms of `error`
-------------------------------------+-------------------------------------
        Reporter:  zilinc            |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  8.2.2
      Resolution:                    |             Keywords:
Operating System:  Linux             |         Architecture:
 Type of failure:  Compile-time      |  Unknown/Multiple
  crash or panic                     |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by zilinc):

 More experiments: after I made the following changes:
 {{{
 diff --git a/cogent/src/Cogent/Desugar.hs b/cogent/src/Cogent/Desugar.hs
 index bdea312..3b8440d 100644
 --- a/cogent/src/Cogent/Desugar.hs
 +++ b/cogent/src/Cogent/Desugar.hs
 @@ -175,9 +175,11 @@ pragmaToNote (_:pragmas) fn note = pragmaToNote
 pragmas fn note
  --
 -----------------------------------------------------------------------------

  lamLftTlv :: S.TopLevel S.RawType B.TypedPatn B.TypedExpr
 -           -> DS t v (S.TopLevel S.RawType B.TypedPatn B.TypedExpr)
 -lamLftTlv (S.FunDef fn sigma alts) = undefined
 +          -> DS t v (S.TopLevel S.RawType B.TypedPatn B.TypedExpr)
 +lamLftTlv (S.FunDef fn sigma alts) = S.FunDef fn sigma <$> mapM lamLftAlt
 alts

 +lamLftAlt :: S.Alt B.TypedPatn B.TypedExpr -> DS t v (S.Alt B.TypedPatn
 B.TypedExpr)
 +lamLftAlt (S.Alt p l e) = S.Alt p l <$> lamLftExpr e

  lamLftExpr :: B.TypedExpr -> DS t v B.TypedExpr
  lamLftExpr (B.TE t (S.Lam p mt e) l) = do
 @@ -192,6 +194,7 @@ lamLftExpr (B.TE t (S.Lam p mt e) l) = do
    let fn = S.FunDef f (S.PT [] t) [S.Alt (B.TP (S.PIrrefutable p) noPos)
 Regular e]  -- no let-generalisation
    lftFun %= (fn:)
    return $ B.TE t (S.TypeApp f [] S.NoInline) l
 +lamLftExpr (B.TE t e l) = B.TE t <$> traverse lamLftExpr e <*> pure l

  -- freeVars :: B.TypedExpr -> Vec v VarName -> [(VarName, S.RawType)]
  -- freeVars (B.TE t (S.Var v) _) vs = maybeToList $ case findIx v vs of
 Just i -> Nothing; Nothing -> Just (v,t)
 @@ -479,7 +482,7 @@ desugarExpr (B.TE t@(S.RT (S.TVariant ts)) (S.Con c
 es) l) = do
  desugarExpr (B.TE _ (S.Seq e1 e2) _) = do
    v <- freshVar
    E <$> (Let v <$> desugarExpr e1 <*> withBinding v (desugarExpr e2))
 -desugarExpr (B.TE _ (S.Lam p mt e) _) = undefined
 +desugarExpr (B.TE _ (S.Lam p mt e) _) = __impossible "desugarExpr (Lam)"
  desugarExpr (B.TE _ (S.App e1 e2) _) = E <$> (App <$> desugarExpr e1 <*>
 desugarExpr e2)
  desugarExpr (B.TE _ (S.If c [] th el) _) = E <$> (If <$> desugarExpr c
 <*> desugarExpr th <*> desugarExpr el)
  desugarExpr (B.TE _ (S.If c vs th el) _) = do
 }}}

 It doesn't crash with the `__impossible`, but this time it crashes with
 the `undefined`.

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14777#comment:9>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler