diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y | 50 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 46 |
2 files changed, 48 insertions, 48 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index e7618289ee..dac78dfcae 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1658,9 +1658,9 @@ btype :: { LHsType RdrName } | atype { $1 } atype :: { LHsType RdrName } - : ntgtycon { sL1 $1 (HsTyVar (unLoc $1)) } -- Not including unit tuples + : ntgtycon { sL1 $1 (HsTyVar $1) } -- Not including unit tuples | tyvar {% do { nwc <- namedWildCardsEnabled -- (See Note [Unit tuples]) - ; let tv@(Unqual name) = unLoc $1 + ; let tv@(L _ (Unqual name)) = $1 ; return $ if (startsWithUnderscore name && nwc) then (sL1 $1 (mkNamedWildCardTy tv)) else (sL1 $1 (HsTyVar tv)) } } @@ -1692,10 +1692,10 @@ atype :: { LHsType RdrName } | '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTy $2) [mj AnnOpenPE $1,mj AnnCloseP $3] } | TH_ID_SPLICE {%ams (sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $ - mkUnqual varName (getTH_ID_SPLICE $1)) + (sL1 $1 (mkUnqual varName (getTH_ID_SPLICE $1)))) [mj AnnThIdSplice $1] } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar $ unLoc $2) [mj AnnSimpleQuote $1,mj AnnName $2] } + | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar $2) [mj AnnSimpleQuote $1,mj AnnName $2] } | SIMPLEQUOTE '(' ctype ',' comma_types1 ')' {% addAnnotation (gl $3) AnnComma (gl $4) >> ams (sLL $1 $> $ HsExplicitTupleTy [] ($3 : $5)) @@ -1703,7 +1703,7 @@ atype :: { LHsType RdrName } | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy placeHolderKind $3) [mj AnnSimpleQuote $1,mos $2,mcs $4] } - | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar $ unLoc $2) + | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar $2) [mj AnnSimpleQuote $1,mj AnnName $2] } -- Two or more [ty, ty, ty] must be a promoted list type, just as @@ -1748,7 +1748,7 @@ tv_bndrs :: { [LHsTyVarBndr RdrName] } | {- empty -} { [] } tv_bndr :: { LHsTyVarBndr RdrName } - : tyvar { sL1 $1 (UserTyVar (unLoc $1)) } + : tyvar { sL1 $1 (UserTyVar $1) } | '(' tyvar '::' kind ')' {% ams (sLL $1 $> (KindedTyVar $2 $4)) [mop $1,mu AnnDcolon $3 ,mcp $5] } @@ -1802,16 +1802,16 @@ bkind :: { LHsKind RdrName } | bkind akind { sLL $1 $> $ HsAppTy $1 $2 } akind :: { LHsKind RdrName } - : '*' {% ams (sL1 $1 $ HsTyVar (nameRdrName liftedTypeKindTyConName)) + : '*' {% ams (sL1 $1 $ HsTyVar (sL1 $1 (nameRdrName liftedTypeKindTyConName))) [mu AnnStar $1] } | '(' kind ')' {% ams (sLL $1 $> $ HsParTy $2) [mop $1,mcp $3] } | pkind { $1 } - | tyvar { sL1 $1 $ HsTyVar (unLoc $1) } + | tyvar { sL1 $1 $ HsTyVar $1 } pkind :: { LHsKind RdrName } -- promoted type, see Note [Promotion] - : qtycon { sL1 $1 $ HsTyVar $ unLoc $1 } - | '(' ')' {% ams (sLL $1 $> $ HsTyVar $ getRdrName unitTyCon) + : qtycon { sL1 $1 $ HsTyVar $1 } + | '(' ')' {% ams (sLL $1 $> $ HsTyVar $ (sLL $1 $> $ getRdrName unitTyCon)) [mop $1,mcp $2] } | '(' kind ',' comma_kinds1 ')' {% addAnnotation (gl $2) AnnComma (gl $3) >> @@ -1977,7 +1977,7 @@ deriving :: { Located (Maybe (Located [LHsType RdrName])) } : {- empty -} { noLoc Nothing } | 'deriving' qtycon {% aljs ( let { L loc tv = $2 } in (sLL $1 $> (Just (sLL $1 $> - [L loc (HsTyVar tv)])))) + [L loc (HsTyVar $2)])))) [mj AnnDeriving $1] } | 'deriving' '(' ')' {% aljs (sLL $1 $> (Just (sLL $1 $> []))) [mj AnnDeriving $1,mop $2,mcp $3] } @@ -2024,7 +2024,7 @@ docdecld :: { LDocDecl } decl_no_th :: { LHsDecl RdrName } : sigdecl { $1 } - | '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar bang_RDR)) $2) }; + | '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2) }; pat <- checkPattern empty e; _ <- ams (sLL $1 $> ()) (fst $ unLoc $3); @@ -2281,8 +2281,8 @@ aexp1 :: { LHsExpr RdrName } | aexp2 { $1 } aexp2 :: { LHsExpr RdrName } - : qvar { sL1 $1 (HsVar $! unLoc $1) } - | qcon { sL1 $1 (HsVar $! unLoc $1) } + : qvar { sL1 $1 (HsVar $! $1) } + | qcon { sL1 $1 (HsVar $! $1) } | ipvar { sL1 $1 (HsIPVar $! unLoc $1) } | overloaded_label { sL1 $1 (HsOverLabel $! unLoc $1) } | literal { sL1 $1 (HsLit $! unLoc $1) } @@ -2339,14 +2339,14 @@ aexp2 :: { LHsExpr RdrName } splice_exp :: { LHsExpr RdrName } : TH_ID_SPLICE {% ams (sL1 $1 $ mkHsSpliceE - (sL1 $1 $ HsVar (mkUnqual varName - (getTH_ID_SPLICE $1)))) + (sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName + (getTH_ID_SPLICE $1))))) [mj AnnThIdSplice $1] } | '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceE $2) [mj AnnOpenPE $1,mj AnnCloseP $3] } | TH_ID_TY_SPLICE {% ams (sL1 $1 $ mkHsSpliceTE - (sL1 $1 $ HsVar (mkUnqual varName - (getTH_ID_TY_SPLICE $1)))) + (sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName + (getTH_ID_TY_SPLICE $1))))) [mj AnnThIdTySplice $1] } | '$$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTE $2) [mj AnnOpenPTE $1,mj AnnCloseP $3] } @@ -2621,7 +2621,7 @@ gdpat :: { LGRHS RdrName (LHsExpr RdrName) } pat :: { LPat RdrName } pat : exp {% checkPattern empty $1 } | '!' aexp {% amms (checkPattern empty (sLL $1 $> (SectionR - (sL1 $1 (HsVar bang_RDR)) $2))) + (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2))) [mj AnnBang $1] } bindpat :: { LPat RdrName } @@ -2629,14 +2629,14 @@ bindpat : exp {% checkPattern (text "Possibly caused by a missing 'do'?") $1 } | '!' aexp {% amms (checkPattern (text "Possibly caused by a missing 'do'?") - (sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2))) + (sLL $1 $> (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2))) [mj AnnBang $1] } apat :: { LPat RdrName } apat : aexp {% checkPattern empty $1 } | '!' aexp {% amms (checkPattern empty (sLL $1 $> (SectionR - (sL1 $1 (HsVar bang_RDR)) $2))) + (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2))) [mj AnnBang $1] } apats :: { [LPat RdrName] } @@ -2938,12 +2938,12 @@ varop :: { Located RdrName } ,mj AnnBackquote $3] } qop :: { LHsExpr RdrName } -- used in sections - : qvarop { sL1 $1 $ HsVar (unLoc $1) } - | qconop { sL1 $1 $ HsVar (unLoc $1) } + : qvarop { sL1 $1 $ HsVar $1 } + | qconop { sL1 $1 $ HsVar $1 } qopm :: { LHsExpr RdrName } -- used in sections - : qvaropm { sL1 $1 $ HsVar (unLoc $1) } - | qconop { sL1 $1 $ HsVar (unLoc $1) } + : qvaropm { sL1 $1 $ HsVar $1 } + | qconop { sL1 $1 $ HsVar $1 } qvarop :: { Located RdrName } : qvarsym { $1 } diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index ed45c4b05d..7d14f6568d 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -442,9 +442,9 @@ splitCon :: LHsType RdrName splitCon ty = split ty [] where - split (L _ (HsAppTy t u)) ts = split t (u : ts) - split (L l (HsTyVar tc)) ts = do data_con <- tyConToDataCon l tc - return (data_con, mk_rest ts) + split (L _ (HsAppTy t u)) ts = split t (u : ts) + split (L l (HsTyVar (L _ tc))) ts = do data_con <- tyConToDataCon l tc + return (data_con, mk_rest ts) split (L l (HsTupleTy HsBoxedOrConstraintTuple ts)) [] = return (L l (getRdrName (tupleDataCon Boxed (length ts))), PrefixCon ts) split (L l _) _ = parseErrorSDoc l (text "Cannot parse data constructor in a data/newtype declaration:" <+> ppr ty) @@ -668,10 +668,10 @@ checkTyVars pp_what equals_or_where tc tparms where -- Check that the name space is correct! - chk (L l (HsKindSig (L lv (HsTyVar tv)) k)) + chk (L l (HsKindSig (L lv (HsTyVar (L _ tv))) k)) | isRdrTyVar tv = return (L l (KindedTyVar (L lv tv) k)) - chk (L l (HsTyVar tv)) - | isRdrTyVar tv = return (L l (UserTyVar tv)) + chk (L l (HsTyVar (L ltv tv))) + | isRdrTyVar tv = return (L l (UserTyVar (L ltv tv))) chk t@(L loc _) = Left (loc, vcat [ ptext (sLit "Unexpected type") <+> quotes (ppr t) @@ -719,7 +719,7 @@ checkTyClHdr is_cls ty where goL (L l ty) acc ann = go l ty acc ann - go l (HsTyVar tc) acc ann + go l (HsTyVar (L _ tc)) acc ann | isRdrTc tc = return (L l tc, acc, ann) go _ (HsOpTy t1 (_, ltc@(L _ tc)) t2) acc ann | isRdrTc tc = return (ltc, t1:t2:acc, ann) @@ -769,7 +769,7 @@ checkLPat msg e@(L l _) = checkPat msg l e [] checkPat :: SDoc -> SrcSpan -> LHsExpr RdrName -> [LPat RdrName] -> P (LPat RdrName) -checkPat _ loc (L l (HsVar c)) args +checkPat _ loc (L l (HsVar (L _ c))) args | isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args))) checkPat msg loc e args -- OK to let this happen even if bang-patterns -- are not enabled, because there is no valid @@ -802,7 +802,7 @@ checkAPat msg loc e0 = do NegApp (L l (HsOverLit pos_lit)) _ -> return (mkNPat (L l pos_lit) (Just noSyntaxExpr)) - SectionR (L lb (HsVar bang)) e -- (! x) + SectionR (L lb (HsVar (L _ bang))) e -- (! x) | bang == bang_RDR -> do { bang_on <- extension bangPatEnabled ; if bang_on then do { e' <- checkLPat msg e @@ -826,7 +826,7 @@ checkAPat msg loc e0 = do return (SigPatIn e (mkHsWithBndrs t')) -- n+k patterns - OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _ + OpApp (L nloc (HsVar (L _ n))) (L _ (HsVar (L _ plus))) _ (L lloc (HsOverLit lit@(OverLit {ol_val = HsIntegral {}}))) | xopt Opt_NPlusKPatterns dynflags && (plus == plus_RDR) -> return (mkNPlusKPat (L nloc n) (L lloc lit)) @@ -834,7 +834,7 @@ checkAPat msg loc e0 = do OpApp l op _fix r -> do l <- checkLPat msg l r <- checkLPat msg r case op of - L cl (HsVar c) | isDataOcc (rdrNameOcc c) + L cl (HsVar (L _ c)) | isDataOcc (rdrNameOcc c) -> return (ConPatIn (L cl c) (InfixCon l r)) _ -> patFail msg loc e0 @@ -860,7 +860,7 @@ checkAPat msg loc e0 = do placeHolderPunRhs :: LHsExpr RdrName -- The RHS of a punned record field will be filled in by the renamer -- It's better not to make it an error, in case we want to print it when debugging -placeHolderPunRhs = noLoc (HsVar pun_RDR) +placeHolderPunRhs = noLoc (HsVar (noLoc pun_RDR)) plus_RDR, bang_RDR, pun_RDR :: RdrName plus_RDR = mkUnqual varName (fsLit "+") -- Hack @@ -943,7 +943,7 @@ checkValSig :: LHsExpr RdrName -> LHsType RdrName -> P (Sig RdrName) -checkValSig (L l (HsVar v)) ty +checkValSig (L l (HsVar (L _ v))) ty | isUnqual v && not (isDataOcc (rdrNameOcc v)) = return (TypeSig [L l v] ty PlaceHolder) checkValSig lhs@(L l _) ty @@ -962,9 +962,9 @@ checkValSig lhs@(L l _) ty -- A common error is to forget the ForeignFunctionInterface flag -- so check for that, and suggest. cf Trac #3805 -- Sadly 'foreign import' still barfs 'parse error' because 'import' is a keyword - looks_like s (L _ (HsVar v)) = v == s - looks_like s (L _ (HsApp lhs _)) = looks_like s lhs - looks_like _ _ = False + looks_like s (L _ (HsVar (L _ v))) = v == s + looks_like s (L _ (HsApp lhs _)) = looks_like s lhs + looks_like _ _ = False foreign_RDR = mkUnqual varName (fsLit "foreign") default_RDR = mkUnqual varName (fsLit "default") @@ -997,7 +997,7 @@ checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr -- not be any OpApps inside the e's splitBang :: LHsExpr RdrName -> Maybe (LHsExpr RdrName, [LHsExpr RdrName]) -- Splits (f ! g a b) into (f, [(! g), a, b]) -splitBang (L _ (OpApp l_arg bang@(L _ (HsVar op)) _ r_arg)) +splitBang (L _ (OpApp l_arg bang@(L _ (HsVar (L _ op))) _ r_arg)) | op == bang_RDR = Just (l_arg, L l' (SectionR bang arg1) : argns) where l' = combineLocs bang arg1 @@ -1022,7 +1022,7 @@ isFunLhs :: LHsExpr RdrName isFunLhs e = go e [] [] where - go (L loc (HsVar f)) es ann + go (L loc (HsVar (L _ f))) es ann | not (isRdrDataCon f) = return (Just (L loc f, False, es, ann)) go (L _ (HsApp f e)) es ann = go f (e:es) ann go (L l (HsPar e)) es@(_:_) ann = go e es (ann ++ mkParensApiAnn l) @@ -1040,7 +1040,7 @@ isFunLhs e = go e [] [] -- ToDo: what about this? -- x + 1 `op` y = ... - go e@(L loc (OpApp l (L loc' (HsVar op)) fix r)) es ann + go e@(L loc (OpApp l (L loc' (HsVar (L _ op))) fix r)) es ann | Just (e',es') <- splitBang e = do { bang_on <- extension bangPatEnabled ; if bang_on then go e' (es' ++ es) ann @@ -1052,9 +1052,9 @@ isFunLhs e = go e [] [] = do { mb_l <- go l es ann ; case mb_l of Just (op', True, j : k : es', ann') - -> return (Just (op', True, j : op_app : es', ann')) - where - op_app = L loc (OpApp k (L loc' (HsVar op)) fix r) + -> return (Just (op', True, j : op_app : es', ann')) + where + op_app = L loc (OpApp k (L loc' (HsVar (L loc' op))) fix r) _ -> return Nothing } go _ _ _ = return Nothing @@ -1190,7 +1190,7 @@ mkRecConstrOrUpdate -> ([LHsRecField RdrName (LHsExpr RdrName)], Bool) -> P (HsExpr RdrName) -mkRecConstrOrUpdate (L l (HsVar c)) _ (fs,dd) +mkRecConstrOrUpdate (L l (HsVar (L _ c))) _ (fs,dd) | isRdrDataCon c = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd)) mkRecConstrOrUpdate exp@(L l _) _ (fs,dd) |