Commit 2205f0ce authored by chak's avatar chak
Browse files

[project @ 2002-06-07 07:16:04 by chak]

Fixed handling of infix operators in types:
- Pretty printing didn't take nested infix operators into account
- Explicit parenthesis were ignored in the fixity parser:
  * I added a constructor `HsParTy' to `HsType' (in the spirit of `HsPar' in
    `HsExpr'), which tracks the use of explicit parenthesis
  * Occurences of `HsParTy' in type-ish things that are not quite types (like
    context predicates) are removed in `ParseUtils'; all other occurences of
    `HsParTy' are removed during type checking (just as it works with `HsPar')
parent f3d24c87
......@@ -109,7 +109,7 @@ data HsType name
| HsAppTy (HsType name)
(HsType name)
| HsFunTy (HsType name) -- function type
| HsFunTy (HsType name) -- function type
(HsType name)
| HsListTy (HsType name) -- Element type
......@@ -120,6 +120,11 @@ data HsType name
[HsType name] -- Element types (length gives arity)
| HsOpTy (HsType name) (HsTyOp name) (HsType name)
| HsParTy (HsType name) -- Parenthesis preserved for the
-- precedence parser; are removed by
-- the type checker
| HsNumTy Integer -- Generics only
-- these next two are only used in interfaces
......@@ -310,16 +315,22 @@ ppr_mono_ty ctxt_prec (HsPArrTy ty) = pabrackets (ppr_mono_ty pREC_TOP ty)
where
pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
= maybeParen (ctxt_prec >= pREC_CON)
(hsep [ppr_mono_ty pREC_FUN fun_ty, ppr_mono_ty pREC_CON arg_ty])
ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) =
maybeParen (ctxt_prec >= pREC_CON)
(hsep [ppr_mono_ty pREC_FUN fun_ty, ppr_mono_ty pREC_CON arg_ty])
ppr_mono_ty ctxt_prec (HsPredTy pred)
= braces (ppr pred)
-- Generics
ppr_mono_ty ctxt_prec (HsNumTy n) = integer n
ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) = ppr ty1 <+> ppr op <+> ppr ty2
ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) =
maybeParen (ctxt_prec >= pREC_FUN)
(ppr_mono_ty pREC_FUN ty1 <+> ppr op <+> ppr_mono_ty pREC_FUN ty2)
ppr_mono_ty ctxt_prec (HsParTy ty) = ppr_mono_ty ctxt_prec ty
-- `HsParTy' isn't useful for pretty printing, as it is removed by the type
-- checker and we need to be able to pretty print after type checking
ppr_mono_ty ctxt_prec (HsNumTy n) = integer n -- generics only
\end{code}
......
......@@ -108,6 +108,8 @@ checkInstType t
checkDictTy ty [] `thenP` \ dict_ty ->
returnP (HsForAllTy tvs ctxt dict_ty)
HsParTy ty -> checkInstType ty
ty -> checkDictTy ty [] `thenP` \ dict_ty->
returnP (HsForAllTy Nothing [] dict_ty)
......@@ -127,11 +129,13 @@ checkTyClHdr :: RdrNameHsType -> P (RdrName, [RdrNameHsTyVar])
checkTyClHdr ty
= go ty []
where
go (HsTyVar tc) acc
go (HsTyVar tc) acc
| not (isRdrTyVar tc) = checkTyVars acc `thenP` \ tvs ->
returnP (tc, tvs)
go (HsOpTy t1 (HsTyOp tc) t2) acc = checkTyVars (t1:t2:acc) `thenP` \ tvs ->
returnP (tc, tvs)
go (HsOpTy t1 (HsTyOp tc) t2) acc
= checkTyVars (t1:t2:acc) `thenP` \ tvs ->
returnP (tc, tvs)
go (HsParTy ty) acc = go ty acc
go (HsAppTy t1 t2) acc = go t1 (t2:acc)
go other acc = parseError "Malformed LHS to type of class declaration"
......@@ -139,6 +143,9 @@ checkContext :: RdrNameHsType -> P RdrNameContext
checkContext (HsTupleTy _ ts) -- (Eq a, Ord b) shows up as a tuple type
= mapP checkPred ts
checkContext (HsParTy ty) -- to be sure HsParTy doesn't get into the way
= checkContext ty
checkContext (HsTyVar t) -- Empty context shows up as a unit type ()
| t == unitTyCon_RDR = returnP []
......@@ -157,12 +164,14 @@ checkPred ty
go (HsTyVar t) args | not (isRdrTyVar t)
= returnP (HsClassP t args)
go (HsAppTy l r) args = go l (r:args)
go (HsParTy t) args = go t args
go _ _ = parseError "Illegal class assertion"
checkDictTy :: RdrNameHsType -> [RdrNameHsType] -> P RdrNameHsType
checkDictTy (HsTyVar t) args@(_:_) | not (isRdrTyVar t)
= returnP (mkHsDictTy t args)
checkDictTy (HsAppTy l r) args = checkDictTy l (r:args)
checkDictTy (HsParTy t) args = checkDictTy t args
checkDictTy _ _ = parseError "Malformed context in instance header"
......@@ -246,7 +255,7 @@ checkPat e [] = case e of
returnP (RecPatIn c fs)
-- Generics
HsType ty -> returnP (TypePatIn ty)
_ -> patFail
_ -> patFail
checkPat _ _ = patFail
......
{- -*-haskell-*-
-----------------------------------------------------------------------------
$Id: Parser.y,v 1.99 2002/06/05 14:39:28 simonpj Exp $
$Id: Parser.y,v 1.100 2002/06/07 07:16:05 chak Exp $
Haskell grammar.
......@@ -805,9 +805,9 @@ atype :: { RdrNameHsType }
| tyvar { HsTyVar $1 }
| '(' type ',' comma_types1 ')' { HsTupleTy (mkHsTupCon tcName Boxed ($2:$4)) ($2:$4) }
| '(#' comma_types1 '#)' { HsTupleTy (mkHsTupCon tcName Unboxed $2) $2 }
| '[' type ']' { HsListTy $2 }
| '[:' type ':]' { HsPArrTy $2 }
| '(' ctype ')' { $2 }
| '[' type ']' { HsListTy $2 }
| '[:' type ':]' { HsPArrTy $2 }
| '(' ctype ')' { HsParTy $2 }
| '(' ctype '::' kind ')' { HsKindSig $2 $4 }
-- Generics
| INTEGER { HsNumTy $1 }
......
......@@ -149,8 +149,9 @@ extract_ty (HsFunTy ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
extract_ty (HsPredTy p) acc = extract_pred p acc
extract_ty (HsTyVar tv) acc = tv : acc
extract_ty (HsForAllTy Nothing cx ty) acc = extract_ctxt cx (extract_ty ty acc)
-- Generics
extract_ty (HsOpTy ty1 nam ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
extract_ty (HsParTy ty) acc = extract_ty ty acc
-- Generics
extract_ty (HsNumTy num) acc = acc
extract_ty (HsKindSig ty k) acc = extract_ty ty acc
extract_ty (HsForAllTy (Just tvs) ctxt ty)
......
......@@ -84,6 +84,7 @@ extractHsTyNames ty
get (HsOpTy ty1 tycon ty2) = get ty1 `unionNameSets` get ty2 `unionNameSets`
case tycon of { HsTyOp n -> unitNameSet n ;
HsArrow -> emptyNameSet }
get (HsParTy ty) = get ty
get (HsNumTy n) = emptyNameSet
get (HsTyVar tv) = unitNameSet tv
get (HsKindSig ty k) = get ty
......
......@@ -110,6 +110,9 @@ rnHsType doc (HsOpTy ty1 op ty2)
lookupTyFixityRn op' `thenRn` \ fix ->
mkHsOpTyRn op' fix ty1' ty2'
rnHsType doc (HsParTy ty)
= rnHsType doc ty `thenRn` \ ty' ->
returnRn (HsParTy ty')
rnHsType doc (HsNumTy i)
| i == 1 = returnRn (HsNumTy i)
......
......@@ -299,6 +299,9 @@ kcHsType ty@(HsOpTy ty1 (HsTyOp op) ty2)
tcAddErrCtxt (appKindCtxt (ppr ty)) $
kcAppKind op_kind ty1_kind `thenTc` \ op_kind' ->
kcAppKind op_kind' ty2_kind
kcHsType (HsParTy ty) -- Skip parentheses markers
= kcHsType ty
kcHsType (HsNumTy _) -- The unit type for generics
= returnTc liftedTypeKind
......@@ -441,6 +444,9 @@ tc_type (HsOpTy ty1 (HsTyOp op) ty2)
tc_type ty2 `thenTc` \ tau_ty2 ->
tc_fun_type op [tau_ty1,tau_ty2]
tc_type (HsParTy ty) -- Remove the parentheses markers
= tc_type ty
tc_type (HsNumTy n)
= ASSERT(n== 1)
returnTc (mkTyConApp genUnitTyCon [])
......
......@@ -82,7 +82,8 @@ patterns (not Unit, this is done differently) is done in mk_inst_info
HsOpTy is tied to Generic definitions which is not a very good design
feature, indeed a bug. However, the check is easy to move from
tcHsType back to mk_inst_info and everything will be fine. Also see
bug #5.
bug #5. [I don't think that this is the case anymore after SPJ's latest
changes in that regard. Delete this comment? -=chak/7Jun2]
Generics.lhs
......
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