diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2016-12-08 10:43:32 +0200 |
---|---|---|
committer | Alan Zimmerman <alan.zimm@gmail.com> | 2016-12-12 20:50:56 +0200 |
commit | 8f6d241a74efa6f6280689a9b14c36c6a9f4c231 (patch) | |
tree | 166fabd22a3f726364eb5f7492bcf5d2ec59c0f4 /compiler/rename/RnSource.hs | |
parent | bc3d37dada357b04fc5a35f740b4fe7e05292b06 (diff) | |
download | haskell-8f6d241a74efa6f6280689a9b14c36c6a9f4c231.tar.gz |
Add infix flag for class and data declarations
Summary:
At the moment, data and type declarations using infix formatting produce the
same AST as those using prefix.
So
type a ++ b = c
and
type (++) a b = c
cannot be distinguished in the parsed source, without looking at the OccName
details of the constructor being defined.
Having access to the OccName requires an additional constraint which explodes
out over the entire AST because of its recursive definitions.
In keeping with moving the parsed source to more directly reflect the source
code as parsed, add a specific flag to the declaration to indicate the fixity,
as used in a Match now too.
Note: this flag is to capture the fixity used for the lexical definition of the
type, primarily for use by ppr and ghc-exactprint.
Updates haddock submodule.
Test Plan: ./validate
Reviewers: mpickering, goldfire, bgamari, austin
Reviewed By: mpickering
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2828
GHC Trac Issues: #12942
Diffstat (limited to 'compiler/rename/RnSource.hs')
-rw-r--r-- | compiler/rename/RnSource.hs | 22 |
1 files changed, 18 insertions, 4 deletions
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 4d0f926b83..65acf808ab 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -798,11 +798,13 @@ rnTyFamInstEqn :: Maybe (Name, [Name]) -> RnM (TyFamInstEqn Name, FreeVars) rnTyFamInstEqn mb_cls (TyFamEqn { tfe_tycon = tycon , tfe_pats = pats + , tfe_fixity = fixity , tfe_rhs = rhs }) = do { (tycon', pats', rhs', fvs) <- rnFamInstDecl (TySynCtx tycon) mb_cls tycon pats rhs rnTySyn ; return (TyFamEqn { tfe_tycon = tycon' , tfe_pats = pats' + , tfe_fixity = fixity , tfe_rhs = rhs' }, fvs) } rnTyFamDefltEqn :: Name @@ -810,12 +812,14 @@ rnTyFamDefltEqn :: Name -> RnM (TyFamDefltEqn Name, FreeVars) rnTyFamDefltEqn cls (TyFamEqn { tfe_tycon = tycon , tfe_pats = tyvars + , tfe_fixity = fixity , tfe_rhs = rhs }) = bindHsQTyVars ctx Nothing (Just cls) [] tyvars $ \ tyvars' _ -> do { tycon' <- lookupFamInstName (Just cls) tycon ; (rhs', fvs) <- rnLHsType ctx rhs ; return (TyFamEqn { tfe_tycon = tycon' , tfe_pats = tyvars' + , tfe_fixity = fixity , tfe_rhs = rhs' }, fvs) } where ctx = TyFamilyCtx tycon @@ -825,11 +829,13 @@ rnDataFamInstDecl :: Maybe (Name, [Name]) -> RnM (DataFamInstDecl Name, FreeVars) rnDataFamInstDecl mb_cls (DataFamInstDecl { dfid_tycon = tycon , dfid_pats = pats + , dfid_fixity = fixity , dfid_defn = defn }) = do { (tycon', pats', (defn', _), fvs) <- rnFamInstDecl (TyDataCtx tycon) mb_cls tycon pats defn rnDataDefn ; return (DataFamInstDecl { dfid_tycon = tycon' , dfid_pats = pats' + , dfid_fixity = fixity , dfid_defn = defn' , dfid_fvs = fvs }, fvs) } @@ -1632,7 +1638,8 @@ rnTyClDecl (FamDecl { tcdFam = decl }) = do { (decl', fvs) <- rnFamDecl Nothing decl ; return (FamDecl decl', fvs) } -rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdRhs = rhs }) +rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, + tcdFixity = fixity, tcdRhs = rhs }) = do { tycon' <- lookupLocatedTopBndrRn tycon ; kvs <- freeKiTyVarsKindVars <$> extractHsTyRdrTyVars rhs ; let doc = TySynCtx tycon @@ -1642,11 +1649,13 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdRhs = rhs }) do { (rhs', fvs) <- rnTySyn doc rhs ; return ((tyvars', rhs'), fvs) } ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars' + , tcdFixity = fixity , tcdRhs = rhs', tcdFVs = fvs }, fvs) } -- "data", "newtype" declarations -- both top level and (for an associated type) in an instance decl -rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdDataDefn = defn }) +rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars, + tcdFixity = fixity, tcdDataDefn = defn }) = do { tycon' <- lookupLocatedTopBndrRn tycon ; kvs <- extractDataDefnKindVars defn ; let doc = TyDataCtx tycon @@ -1662,11 +1671,13 @@ rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdDataDefn = defn ; let cusk = hsTvbAllKinded tyvars' && (not typeintype || no_kvs) ; return (DataDecl { tcdLName = tycon', tcdTyVars = tyvars' + , tcdFixity = fixity , tcdDataDefn = defn', tcdDataCusk = cusk , tcdFVs = fvs }, fvs) } rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls, - tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs, + tcdTyVars = tyvars, tcdFixity = fixity, + tcdFDs = fds, tcdSigs = sigs, tcdMeths = mbinds, tcdATs = ats, tcdATDefs = at_defs, tcdDocs = docs}) = do { lcls' <- lookupLocatedTopBndrRn lcls @@ -1720,7 +1731,8 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls, ; let all_fvs = meth_fvs `plusFV` stuff_fvs `plusFV` fv_at_defs ; return (ClassDecl { tcdCtxt = context', tcdLName = lcls', - tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs', + tcdTyVars = tyvars', tcdFixity = fixity, + tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds', tcdATs = ats', tcdATDefs = at_defs', tcdDocs = docs', tcdFVs = all_fvs }, all_fvs ) } @@ -1811,6 +1823,7 @@ rnFamDecl :: Maybe Name -- Just cls => this FamilyDecl is nested -> FamilyDecl RdrName -> RnM (FamilyDecl Name, FreeVars) rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars + , fdFixity = fixity , fdInfo = info, fdResultSig = res_sig , fdInjectivityAnn = injectivity }) = do { tycon' <- lookupLocatedTopBndrRn tycon @@ -1825,6 +1838,7 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars ; return ( (tyvars', res_sig', injectivity') , fv_kind ) } ; (info', fv2) <- rn_info info ; return (FamilyDecl { fdLName = tycon', fdTyVars = tyvars' + , fdFixity = fixity , fdInfo = info', fdResultSig = res_sig' , fdInjectivityAnn = injectivity' } , fv1 `plusFV` fv2) } |