Commit 3f9d24d5 authored by simonpj's avatar simonpj
Browse files

Fix Trac #5038 (missing free variable in ifThenElse rebindable syntax)

parent 08c5b670
......@@ -12,7 +12,7 @@ module RnEnv (
lookupLocalDataTcNames, lookupSigOccRn,
lookupFixityRn, lookupTyFixityRn,
lookupInstDeclBndr, lookupSubBndr, lookupConstructorFields,
lookupSyntaxName, lookupSyntaxTable,
lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse,
lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
getLookupOccRn, addUsedRdrNames,
......@@ -754,6 +754,17 @@ We treat the orignal (standard) names as free-vars too, because the type checker
checks the type of the user thing against the type of the standard thing.
lookupIfThenElse :: RnM (Maybe (SyntaxExpr Name), FreeVars)
-- Different to lookupSyntaxName because in the non-rebindable
-- case we desugar directly rather than calling an existing function
-- Hence the (Maybe (SyntaxExpr Name)) return type
= do { rebind <- xoptM Opt_RebindableSyntax
; if not rebind
then return (Nothing, emptyFVs)
else do { ite <- lookupOccRn (mkVarUnqual (fsLit "ifThenElse"))
; return (Just (HsVar ite), unitFV ite) } }
lookupSyntaxName :: Name -- The standard name
-> RnM (SyntaxExpr Name, FreeVars) -- Possibly a non-standard name
lookupSyntaxName std_name
......@@ -270,11 +270,8 @@ rnExpr (HsIf _ p b1 b2)
= do { (p', fvP) <- rnLExpr p
; (b1', fvB1) <- rnLExpr b1
; (b2', fvB2) <- rnLExpr b2
; rebind <- xoptM Opt_RebindableSyntax
; if not rebind
then return (HsIf Nothing p' b1' b2', plusFVs [fvP, fvB1, fvB2])
else do { c <- liftM HsVar (lookupOccRn (mkVarUnqual (fsLit "ifThenElse")))
; return (HsIf (Just c) p' b1' b2', plusFVs [fvP, fvB1, fvB2]) }}
; (mb_ite, fvITE) <- lookupIfThenElse
; return (HsIf mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2]) }
rnExpr (HsType a)
= rnHsTypeFVs doc a `thenM` \ (t, fvT) ->
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment