Ticket #4430: compiler.patch

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

    From c9c994602783da6966703958c1b4e1b08cfdcd4c Mon Sep 17 00:00:00 2001
    From: Reiner Pope <[email protected]>
    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