Ticket #4430: compiler.patch

File compiler.patch, 4.1 KB (added by reinerp, 3 years ago)
  • compiler/hsSyn/Convert.lhs

    From c9c994602783da6966703958c1b4e1b08cfdcd4c Mon Sep 17 00:00:00 2001
    From: Reiner Pope <reiner.pope@gmail.com>
    Date: Tue, 19 Jul 2011 18:24:25 +1000
    Subject: [PATCH] Add unresolved infix patterns and expressions
    
    ---
     compiler/hsSyn/Convert.lhs |   35 ++++++++++++++++++++++++++++++++---
     1 files changed, 32 insertions(+), 3 deletions(-)
    
    diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
    index cd584e1..bb2d5bd 100644
    a b cvtl e = wrapL (cvt e) 
    482482             -- Note [Converting strings] 
    483483      | otherwise                    = do { xs' <- mapM cvtl xs; return $ ExplicitList void xs' } 
    484484    cvt (InfixE (Just x) s (Just y)) = do { x' <- cvtl x; s' <- cvtl s; y' <- cvtl y 
    485                                           ; e' <- returnL $ OpApp x' s' undefined y' 
     485                                          ; x'' <- returnL (HsPar x'); y'' <- returnL (HsPar y') 
     486                                          ; e' <- returnL $ OpApp x'' s' undefined y'' 
    486487                                          ; return $ HsPar e' } 
    487488    cvt (InfixE Nothing  s (Just y)) = do { s' <- cvtl s; y' <- cvtl y 
    488489                                          ; sec <- returnL $ SectionR s' y' 
    cvtl e = wrapL (cvt e) 
    491492                                          ; sec <- returnL $ SectionL x' s' 
    492493                                          ; return $ HsPar sec } 
    493494    cvt (InfixE Nothing  s Nothing ) = cvt s    -- Can I indicate this is an infix thing? 
    494  
     495    cvt (UnresolvedInfixE x s y) = do { x' <- cvtl x; cvtOpApp x' s y } 
     496    cvt (ParensE e)      = do { e' <- cvtl e; return $ HsPar e' } 
    495497    cvt (SigE e t)       = do { e' <- cvtl e; t' <- cvtType t 
    496498                              ; return $ ExprWithTySig e' t' } 
    497499    cvt (RecConE c flds) = do { c' <- cNameL c 
    cvtDD (FromThenR x y) = do { x' <- cvtl x; y' <- cvtl y; return $ FromThen x 
    512514cvtDD (FromToR x y)       = do { x' <- cvtl x; y' <- cvtl y; return $ FromTo x' y' } 
    513515cvtDD (FromThenToR x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; return $ FromThenTo x' y' z' } 
    514516 
     517-- | @cvtOpApp x op y@ converts @op@ and @y@ and produces the operator application @x `op` y@. 
     518-- The produced tree of infix expressions will be left-biased, provided @x@ is. 
     519cvtOpApp :: LHsExpr RdrName -> TH.Exp -> TH.Exp -> CvtM (HsExpr RdrName) 
     520cvtOpApp x op1 (UnresolvedInfixE y op2 z) 
     521  = do { l <- wrapL $ cvtOpApp x op1 y 
     522       ; cvtOpApp l op2 z } 
     523cvtOpApp x op y 
     524  = do { op' <- cvtl op 
     525       ; y' <- cvtl y 
     526       ; return (OpApp x op' undefined y') } 
     527 
    515528------------------------------------- 
    516529--      Do notation and statements 
    517530------------------------------------- 
    cvtp (UnboxedTupP [p]) = cvtp p 
    635648cvtp (UnboxedTupP ps)  = do { ps' <- cvtPats ps; return $ TuplePat ps' Unboxed void } 
    636649cvtp (ConP s ps)      = do { s' <- cNameL s; ps' <- cvtPats ps; return $ ConPatIn s' (PrefixCon ps') } 
    637650cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2 
    638                            ; return $ ConPatIn s' (InfixCon p1' p2') } 
     651                           ; p1'' <- returnL (ParPat p1'); p2'' <- returnL (ParPat p2') 
     652                           ; p <- returnL $ ConPatIn s' (InfixCon p1'' p2'')  
     653                           ; return $ ParPat p } 
     654cvtp (UnresolvedInfixP p1 s p2)  
     655                      = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } 
     656cvtp (ParensP p)      = do { p' <- cvtPat p; return $ ParPat p' } 
    639657cvtp (TildeP p)       = do { p' <- cvtPat p; return $ LazyPat p' } 
    640658cvtp (BangP p)        = do { p' <- cvtPat p; return $ BangPat p' } 
    641659cvtp (TH.AsP s p)     = do { s' <- vNameL s; p' <- cvtPat p; return $ AsPat s' p' } 
    cvtPatFld (s,p) 
    651669  = do  { s' <- vNameL s; p' <- cvtPat p 
    652670        ; return (HsRecField { hsRecFieldId = s', hsRecFieldArg = p', hsRecPun = False}) } 
    653671 
     672-- | @cvtOpAppP x op y@ converts @op@ and @y@ and produces the operator application @x `op` y@. 
     673-- The produced tree of infix patterns will be left-biased, provided @x@ is. 
     674cvtOpAppP :: Hs.LPat RdrName -> TH.Name -> TH.Pat -> CvtM (Hs.Pat RdrName) 
     675cvtOpAppP x op1 (UnresolvedInfixP y op2 z)  
     676  = do { l <- wrapL $ cvtOpAppP x op1 y 
     677       ; cvtOpAppP l op2 z } 
     678cvtOpAppP x op y 
     679  = do { op' <- cNameL op 
     680       ; y' <- cvtPat y 
     681       ; return (ConPatIn op' (InfixCon x y')) } 
     682 
    654683----------------------------------------------------------- 
    655684--      Types and type variables 
    656685