[commit: ghc] wip/T11028: Comment cleanups (7b96954)
git at git.haskell.org
git at git.haskell.org
Tue Dec 1 12:59:12 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T11028
Link : http://ghc.haskell.org/trac/ghc/changeset/7b9695427d4acfe31ef58d4ed4b8b0d63f908597/ghc
>---------------------------------------------------------------
commit 7b9695427d4acfe31ef58d4ed4b8b0d63f908597
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date: Tue Dec 1 14:59:27 2015 +0200
Comment cleanups
>---------------------------------------------------------------
7b9695427d4acfe31ef58d4ed4b8b0d63f908597
compiler/deSugar/DsMeta.hs | 1 -
compiler/parser/Parser.y | 1 -
compiler/parser/RdrHsSyn.hs | 43 +++++---------------------------------
compiler/rename/RnSource.hs | 23 --------------------
compiler/typecheck/TcTyClsDecls.hs | 18 +---------------
5 files changed, 6 insertions(+), 80 deletions(-)
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index faac397..48c4126 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -662,7 +662,6 @@ repC tvs (L _ (ConDeclGADT { con_names = cons
addTyVarBinds ex_tvs $ \ ex_bndrs -> -- Binds the remaining con_tvs
do { cons1 <- mapM lookupLOcc cons -- See Note [Binders and occurrences]
; let (details,res_ty',_,_) = gadtDeclDetails res_ty
- -- AZ: Is this doc context appropriate?
; let doc = ptext (sLit "In the constructor for ") <+> ppr (head cons)
; (hs_details,_res_ty) <- update_con_result doc details res_ty'
; c' <- mapM (\c -> repConstr c hs_details) cons1
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index b95c415..bbde989 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -2670,7 +2670,6 @@ stmtlist :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
-- here, because we need too much lookahead if we see do { e ; }
-- So we use BodyStmts throughout, and switch the last one over
-- in ParseUtils.checkDo instead
--- AZ: TODO check that we can retrieve multiple semis.
stmts :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
: stmts ';' stmt {% if null (snd $ unLoc $1)
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index b3175dd..70be8e5 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -508,39 +508,6 @@ mkGadtDecl names ty = ConDeclGADT { con_names = names
, con_type = ty
, con_doc = Nothing }
-{-
-mkGadtDecl' :: [Located RdrName]
- -> LHsSigType RdrName
- -> ConDecl RdrName
--- We allow C,D :: ty
--- and expand it as if it had been
--- C :: ty; D :: ty
--- (Just like type signatures in general.)
-
-mkGadtDecl' names lbody_ty@(L loc body_ty)
- = mk_gadt_con names
- where
- (tvs, cxt, tau) = splitLHsSigmaTy lbody_ty
- (details, res_ty) -- See Note [Sorting out the result type]
- = case tau of
- L _ (HsFunTy (L l (HsRecTy flds)) res_ty)
- -> (RecCon (L l flds), res_ty)
- _other -> (PrefixCon [], tau)
-
- explicit = case body_ty of
- HsForAllTy {} -> True
- _ -> False
-
- mk_gadt_con names
- = ConDecl { con_names = names
- , con_explicit = explicit
- , con_qvars = mkHsQTvs tvs
- , con_cxt = cxt
- , con_details = details
- , con_res = ResTyGADT loc res_ty
- , con_doc = Nothing }
--}
-
-- AZ:TODO: this probably belongs in a different module
gadtDeclDetails :: LHsSigType name
-> (HsConDeclDetails name,LHsType name,LHsContext name,[LHsTyVarBndr name])
@@ -652,19 +619,19 @@ really doesn't matter!
-- | Note [Sorting out the result type]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- In a GADT declaration which is not a record, we put the whole constr
--- type into the ResTyGADT for now; the renamer will unravel it once it
--- has sorted out operator fixities. Consider for example
+-- In a GADT declaration which is not a record, we put the whole constr type
+-- into the res_ty for a ConDeclGADT for now; the renamer will unravel it once
+-- it has sorted out operator fixities. Consider for example
-- C :: a :*: b -> a :*: b -> a :+: b
-- Initially this type will parse as
-- a :*: (b -> (a :*: (b -> (a :+: b))))
-
+--
-- so it's hard to split up the arguments until we've done the precedence
-- resolution (in the renamer) On the other hand, for a record
-- { x,y :: Int } -> a :*: b
-- there is no doubt. AND we need to sort records out so that
-- we can bring x,y into scope. So:
--- * For PrefixCon we keep all the args in the ResTyGADT
+-- * For PrefixCon we keep all the args in the res_ty
-- * For RecCon we do not
checkTyVarsP :: SDoc -> SDoc -> Located RdrName -> [LHsType RdrName] -> P (LHsQTyVars RdrName)
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index d1de338..fb6ab27 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -1506,29 +1506,6 @@ modules), we get better error messages, too.
\subsection{Support code for type/data declarations}
* *
*********************************************************
-
-Note [Quantification in data constructor declarations]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Four cases, afer renaming
- * ResTyH98
- - data T a = forall b. MkT { x :: b -> a }
- The 'b' is explicitly declared;
- con_qvars = [b]
-
- - data T a = MkT { x :: a -> b }
- Do *not* implicitly quantify over 'b'; it is
- simply out of scope. con_qvars = []
-
- * ResTyGADT
- - data T a where { MkT :: forall b. (b -> a) -> T a }
- con_qvars = [a,b]
-
- - data T a where { MkT :: (b -> a) -> T a }
- con_qvars = [a,b], by implicit quantification
- of the type signature
- It is uncomfortable that we add implicitly-bound
- type variables to the HsQTyVars, which usually
- only has explicitly-bound type variables
-}
---------------
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 489b94c..57960d7 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -1274,12 +1274,6 @@ tcConDecl new_or_data is_prom rep_tycon tmpl_tvs res_tmpl
; return (ctxt, arg_tys, field_lbls, stricts)
}
- -- Generalise the kind variables (returning quantified TcKindVars)
- -- and quantify the type variables (substituting their kinds)
- -- REMEMBER: 'tkvs' are:
- -- ResTyH98: the *existential* type variables only
- -- ResTyGADT: *all* the quantified type variables
- -- c.f. the comment on con_qvars in HsDecls
; tkvs <- quantifyTyVars (mkVarSet tmpl_tvs) (tyVarsOfTypes (ctxt++arg_tys))
-- Zonk to Types
@@ -1321,16 +1315,6 @@ tcConDecl _new_or_data is_prom rep_tycon tmpl_tvs res_tmpl
, con_type = ty@(HsIB { hsib_kvs = _kvs, hsib_tvs = _tvs, hsib_body = _bty}) })
= addErrCtxt (dataConCtxtName names) $
do { traceTc "tcConDecl 1" (ppr names)
- {-
- AZ:TODO:not sure where this comment now belongs:
-
- -- Generalise the kind variables (returning quantified TcKindVars)
- -- and quantify the type variables (substituting their kinds)
- -- REMEMBER: 'tkvs' are:
- -- ResTyH98: the *existential* type variables only
- -- ResTyGADT: *all* the quantified type variables
- -- c.f. the comment on con_qvars in HsDecls
- -}
; (ctxt, stricts, field_lbls, arg_tys, res_ty,hs_details)
<- tcGadtSigType (ppr names) (unLoc $ head names) ty
; tkvs <- quantifyTyVars emptyVarSet (tyVarsOfTypes (res_ty:ctxt++arg_tys))
@@ -1583,7 +1567,7 @@ data SList s as where
We call tcResultType with
tmpl_tvs = [(k :: BOX), (s :: k -> *), (as :: List k)]
res_tmpl = SList k s as
- res_ty = ResTyGADT (SList k1 (s1 :: k1 -> *) (Nil k1))
+ res_ty = (SList k1 (s1 :: k1 -> *) (Nil k1))
We get subst:
k -> k1
More information about the ghc-commits
mailing list