Commit 589ba227 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.

Cleanup (re type function parsing)

Mon Jul 31 17:20:56 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Cleanup (re type function parsing)
parent 72264dbc
......@@ -329,6 +329,24 @@ Interface file code:
-- for a module. That's why (despite the misnomer) IfaceSig and ForeignType
-- are both in TyClDecl
-- Representation of type functions and associated data types & synonyms
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- 'TyData' and 'TySynonym' have a field 'tcdPats::Maybe [LHsType name]', with
-- the following meaning:
--
-- * If it is 'Nothing', we have a *vanilla* data type declaration or type
-- synonym declaration and 'tcdVars' contains the type parameters of the
-- type constructor.
--
-- * If it is 'Just pats', we have the definition of an associated data type
-- or a type function equations (toplevel or nested in an instance
-- declarations). Then, 'pats' are type patterns for the type-indexes of
-- the type constructor and 'tcdVars' are the variables in those
-- patterns. Hence, the arity of the type constructor is 'length tcdPats'
-- and *not* 'length tcdVars'.
--
-- In both cases, 'tcdVars' collects all variables we need to quantify over.
type LTyClDecl name = Located (TyClDecl name)
data TyClDecl name
......@@ -368,6 +386,8 @@ data TyClDecl name
| TySynonym { tcdLName :: Located name, -- type constructor
tcdTyVars :: [LHsTyVarBndr name], -- type variables
tcdTyPats :: Maybe [LHsType name], -- Type patterns
-- 'Nothing' => vanilla
-- type synonym
tcdSynRhs :: LHsType name -- synonym expansion
}
......@@ -378,7 +398,8 @@ data TyClDecl name
tcdSigs :: [LSig name], -- Methods' signatures
tcdMeths :: LHsBinds name, -- Default methods
tcdATs :: [LTyClDecl name] -- Associated types; ie
-- only 'TyData'
-- only 'TyData',
-- 'TyFunction',
-- and 'TySynonym'
}
......@@ -653,7 +674,8 @@ data InstDecl name
-- figures out the quantified type variables for us.
(LHsBinds name)
[LSig name] -- User-supplied pragmatic info
[LTyClDecl name]-- Associated types
[LTyClDecl name]-- Associated types (ie, 'TyData' and
-- 'TySynonym' only)
instance (OutputableBndr name) => Outputable (InstDecl name) where
......
......@@ -467,7 +467,7 @@ cl_decl :: { LTyClDecl RdrName }
: 'class' tycl_hdr fds where
{% do { let { (binds, sigs, ats) =
cvBindsAndSigs (unLoc $4)
; (ctxt, tc, tvs, Just tparms) = unLoc $2}
; (ctxt, tc, tvs, tparms) = unLoc $2}
; checkTyVars tparms False -- only type vars allowed
; return $ L (comb4 $1 $2 $3 $4)
(mkClassDecl (ctxt, tc, tvs)
......@@ -505,19 +505,25 @@ ty_decl :: { LTyClDecl RdrName }
-- data type or newtype declaration
| data_or_newtype tycl_hdr constrs deriving
{ L (comb4 $1 $2 $3 $4) -- We need the location on tycl_hdr
-- in case constrs and deriving are
-- both empty
(mkTyData (unLoc $1) (unLoc $2) Nothing
(reverse (unLoc $3)) (unLoc $4)) }
{% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
; tpats <- checkTyVars tparms True -- can have type pats
; return $
L (comb4 $1 $2 $3 $4)
-- We need the location on tycl_hdr in case
-- constrs and deriving are both empty
(mkTyData (unLoc $1) (ctxt, tc, tvs, tpats)
Nothing (reverse (unLoc $3)) (unLoc $4)) } }
-- GADT declaration
| data_or_newtype tycl_hdr opt_kind_sig
'where' gadt_constrlist
deriving
{ L (comb4 $1 $2 $4 $5)
(mkTyData (unLoc $1) (unLoc $2) $3
(reverse (unLoc $5)) (unLoc $6)) }
{% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
; tpats <- checkTyVars tparms True -- can have type pats
; return $
L (comb4 $1 $2 $4 $5)
(mkTyData (unLoc $1) (ctxt, tc, tvs, tpats) $3
(reverse (unLoc $5)) (unLoc $6)) } }
opt_iso :: { Bool }
: { False }
......@@ -540,7 +546,7 @@ opt_kind_sig :: { Maybe Kind }
: { Nothing }
| '::' kind { Just (unLoc $2) }
-- tycl_hdr parses the header of a type decl,
-- tycl_hdr parses the header of a class or data type decl,
-- which takes the form
-- T a b
-- Eq a => T a
......@@ -550,7 +556,7 @@ opt_kind_sig :: { Maybe Kind }
tycl_hdr :: { Located (LHsContext RdrName,
Located RdrName,
[LHsTyVarBndr RdrName],
Maybe [LHsType RdrName]) }
[LHsType RdrName]) }
: context '=>' type {% checkTyClHdr $1 $3 >>= return.LL }
| type {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
......
......@@ -35,7 +35,7 @@ module RdrHsSyn (
checkPrecP, -- Int -> P Int
checkContext, -- HsType -> P HsContext
checkPred, -- HsType -> P HsPred
checkTyClHdr, -- LHsContext RdrName -> LHsType RdrName -> P (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName])
checkTyClHdr, -- LHsContext RdrName -> LHsType RdrName -> P (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName], [LHsType RdrName])
checkTyVars, -- [LHsType RdrName] -> Bool -> P ()
checkSynHdr, -- LHsType RdrName -> P (Located RdrName, [LHsTyVarBndr RdrName], Maybe [LHsType RdrName])
checkTopTyClD, -- LTyClDecl RdrName -> P (HsDecl RdrName)
......@@ -401,7 +401,8 @@ checkTyVars tparms nonVarsOk =
-- Check whether the type arguments in a type synonym head are simply
-- variables. If not, we have a type equation of a type function and return
-- all patterns. If yes, we return 'Nothing' as the third component to
-- indicate a vanilla type synonym.
--
checkSynHdr :: LHsType RdrName
-> Bool -- non-variables admitted?
......@@ -409,7 +410,7 @@ checkSynHdr :: LHsType RdrName
[LHsTyVarBndr RdrName], -- parameters
Maybe [LHsType RdrName]) -- type patterns
checkSynHdr ty nonVarsOk =
do { (_, tc, tvs, Just tparms) <- checkTyClHdr (noLoc []) ty
do { (_, tc, tvs, tparms) <- checkTyClHdr (noLoc []) ty
; typats <- checkTyVars tparms nonVarsOk
; return (tc, tvs, typats) }
......@@ -420,8 +421,7 @@ checkTyClHdr :: LHsContext RdrName -> LHsType RdrName
-> P (LHsContext RdrName, -- the type context
Located RdrName, -- the head symbol (type or class name)
[LHsTyVarBndr RdrName], -- free variables of the non-context part
Maybe [LHsType RdrName]) -- parameters of head symbol; wrapped into
-- 'Maybe' for 'mkTyData'
[LHsType RdrName]) -- parameters of head symbol
-- The header of a type or class decl should look like
-- (C a, D b) => T a b
-- or T a b
......@@ -437,7 +437,7 @@ checkTyClHdr :: LHsContext RdrName -> LHsType RdrName
checkTyClHdr (L l cxt) ty
= do (tc, tvs, parms) <- gol ty []
mapM_ chk_pred cxt
return (L l cxt, tc, tvs, Just parms)
return (L l cxt, tc, tvs, parms)
where
gol (L l ty) acc = go l ty acc
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment