X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FRdrHsSyn.lhs;h=c29f23a298b0f11a79990fdf057596caa78dff62;hb=47ec5807dfabbe140b60fcb35af8a105b78ba140;hp=895c8a868734c854929d1b1c3f81108eb6a7c4d4;hpb=90dc9026b091be5cca5da4c6cbd3713ecc493361;p=ghc-hetmet.git diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 895c8a8..c29f23a 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -54,7 +54,7 @@ module RdrHsSyn ( #include "HsVersions.h" import HsSyn -- Lots of it -import RdrName ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc, +import RdrName ( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc, isRdrDataCon, isUnqual, getRdrName, isQual, setRdrNameSpace ) import BasicTypes ( maxPrecedence, Activation, InlineSpec(..), alwaysInlineSpec, neverInlineSpec ) @@ -468,13 +468,12 @@ checkTyClHdr (L l cxt) ty where gol (L l ty) acc = go l ty acc - go l (HsTyVar tc) acc - | not (isRdrTyVar tc) = do - tvs <- extractTyVars acc - return (L l tc, tvs, acc) - go l (HsOpTy t1 tc t2) acc = do - tvs <- extractTyVars (t1:t2:acc) - return (tc, tvs, acc) + go l (HsTyVar tc) acc + | isRdrTc tc = do tvs <- extractTyVars acc + return (L l tc, tvs, acc) + go l (HsOpTy t1 ltc@(L _ tc) t2) acc + | isRdrTc tc = do tvs <- extractTyVars (t1:t2:acc) + return (ltc, tvs, acc) go l (HsParTy ty) acc = gol ty acc go l (HsAppTy t1 t2) acc = gol t1 (t2:acc) go l other acc = @@ -705,8 +704,8 @@ checkAPat loc e = case e of ExplicitTuple es b -> mapM (\e -> checkLPat e) es >>= \ps -> return (TuplePat ps b placeHolderType) - RecordCon c _ fs -> mapM checkPatField fs >>= \fs -> - return (ConPatIn c (RecCon (map (uncurry mkRecField) fs))) + RecordCon c _ (HsRecordBinds fs) -> mapM checkPatField fs >>= \fs -> + return (ConPatIn c (RecCon (map (uncurry mkRecField) fs))) -- Generics HsType ty -> return (TypePat ty) _ -> patFail loc @@ -873,9 +872,9 @@ mkRecConstrOrUpdate mkRecConstrOrUpdate (L l (HsVar c)) loc fs | isRdrDataCon c = return (RecordCon (L l c) noPostTcExpr fs) -mkRecConstrOrUpdate exp loc fs@(_:_) +mkRecConstrOrUpdate exp loc fs@(HsRecordBinds (_:_)) = return (RecordUpd exp fs placeHolderType placeHolderType) -mkRecConstrOrUpdate _ loc [] +mkRecConstrOrUpdate _ loc (HsRecordBinds []) = parseError loc "Empty record update" mkInlineSpec :: Maybe Activation -> Bool -> InlineSpec