diff options
Diffstat (limited to 'compiler/hsSyn/Convert.hs')
| -rw-r--r-- | compiler/hsSyn/Convert.hs | 32 |
1 files changed, 27 insertions, 5 deletions
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 12f22e8dd3..97329aaa55 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -925,7 +925,7 @@ cvtl e = wrapL (cvt e) } -- Infix expressions - cvt (InfixE (Just x) s (Just y)) = + cvt (InfixE (Just x) s (Just y)) = ensureValidOpExp s $ do { x' <- cvtl x ; s' <- cvtl s ; y' <- cvtl y @@ -937,20 +937,24 @@ cvtl e = wrapL (cvt e) -- to ensure this operator application does -- does not get re-associated -- See Note [Operator association] - cvt (InfixE Nothing s (Just y)) = do { s' <- cvtl s; y' <- cvtl y + cvt (InfixE Nothing s (Just y)) = ensureValidOpExp s $ + do { s' <- cvtl s; y' <- cvtl y ; wrapParL (HsPar noExt) $ SectionR noExt s' y' } -- See Note [Sections in HsSyn] in HsExpr - cvt (InfixE (Just x) s Nothing ) = do { x' <- cvtl x; s' <- cvtl s + cvt (InfixE (Just x) s Nothing ) = ensureValidOpExp s $ + do { x' <- cvtl x; s' <- cvtl s ; wrapParL (HsPar noExt) $ SectionL noExt x' s' } - cvt (InfixE Nothing s Nothing ) = do { s' <- cvtl s + cvt (InfixE Nothing s Nothing ) = ensureValidOpExp s $ + do { s' <- cvtl s ; return $ HsPar noExt s' } -- Can I indicate this is an infix thing? -- Note [Dropping constructors] - cvt (UInfixE x s y) = do { x' <- cvtl x + cvt (UInfixE x s y) = ensureValidOpExp s $ + do { x' <- cvtl x ; let x'' = case unLoc x' of OpApp {} -> x' _ -> mkLHsPar x' @@ -977,6 +981,24 @@ cvtl e = wrapL (cvt e) cvt (LabelE s) = do { return $ HsOverLabel noExt Nothing (fsLit s) } cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExt n' } +{- | #16895 Ensure an infix expression's operator is a variable/constructor. +Consider this example: + + $(uInfixE [|1|] [|id id|] [|2|]) + +This infix expression is obviously ill-formed so we use this helper function +to reject such programs outright. + +The constructors `ensureValidOpExp` permits should be in sync with `pprInfixExp` +in Language.Haskell.TH.Ppr from the template-haskell library. +-} +ensureValidOpExp :: TH.Exp -> CvtM a -> CvtM a +ensureValidOpExp (VarE _n) m = m +ensureValidOpExp (ConE _n) m = m +ensureValidOpExp (UnboundVarE _n) m = m +ensureValidOpExp _e _m = + failWith (text "Non-variable expression is not allowed in an infix expression") + {- Note [Dropping constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we drop constructors from the input (for instance, when we encounter @TupE [e]@) |