projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1997-03-14 07:52:06 by simonpj]
[ghc-hetmet.git]
/
ghc
/
compiler
/
types
/
PprType.lhs
diff --git
a/ghc/compiler/types/PprType.lhs
b/ghc/compiler/types/PprType.lhs
index
aef3208
..
3d03685
100644
(file)
--- a/
ghc/compiler/types/PprType.lhs
+++ b/
ghc/compiler/types/PprType.lhs
@@
-31,7
+31,7
@@
IMPORT_DELOOPER(IdLoop)
-- friends:
-- (PprType can see all the representations it's trying to print)
import Type ( GenType(..), maybeAppTyCon,
-- friends:
-- (PprType can see all the representations it's trying to print)
import Type ( GenType(..), maybeAppTyCon,
- splitForAllTy, splitSigmaTy, splitRhoTy, splitAppTy )
+ splitForAllTy, splitSigmaTy, splitRhoTy, splitAppTys )
import TyVar ( GenTyVar(..) )
import TyCon ( TyCon(..), NewOrData )
import Class ( SYN_IE(Class), GenClass(..),
import TyVar ( GenTyVar(..) )
import TyCon ( TyCon(..), NewOrData )
import Class ( SYN_IE(Class), GenClass(..),
@@
-51,7
+51,7
@@
import PprEnv
import PprStyle ( PprStyle(..), codeStyle, showUserishTypes )
import Pretty
import UniqFM ( addToUFM_Directly, lookupUFM_Directly{-, ufmToList ToDo:rm-} )
import PprStyle ( PprStyle(..), codeStyle, showUserishTypes )
import Pretty
import UniqFM ( addToUFM_Directly, lookupUFM_Directly{-, ufmToList ToDo:rm-} )
-import Unique ( pprUnique10, pprUnique, incrUnique, listTyConKey )
+import Unique --TEMP: ( pprUnique10, pprUnique, incrUnique, listTyConKey )
import Util
\end{code}
import Util
\end{code}
@@
-177,13
+177,13
@@
ppr_ty env ctxt_prec (FunTy ty1 ty2 usage)
-- so that right associativity comes out nicely...
= maybeParen ctxt_prec fUN_PREC
(ppCat [ppr_ty env fUN_PREC ty1,
-- so that right associativity comes out nicely...
= maybeParen ctxt_prec fUN_PREC
(ppCat [ppr_ty env fUN_PREC ty1,
- ppPStr SLIT("->"),
+ ppStr "->",
ppr_ty env tOP_PREC ty2])
ppr_ty env ctxt_prec ty@(AppTy _ _)
= ppr_corner env ctxt_prec fun_ty arg_tys
where
ppr_ty env tOP_PREC ty2])
ppr_ty env ctxt_prec ty@(AppTy _ _)
= ppr_corner env ctxt_prec fun_ty arg_tys
where
- (fun_ty, arg_tys) = splitAppTy ty
+ (fun_ty, arg_tys) = splitAppTys ty
ppr_ty env ctxt_prec (SynTy tycon tys expansion)
| codeStyle (pStyle env)
ppr_ty env ctxt_prec (SynTy tycon tys expansion)
| codeStyle (pStyle env)
@@
-275,7
+275,7
@@
pprGenTyVar sty (TyVar uniq kind name usage)
= case sty of
PprInterface -> pp_u
_ -> ppBesides [pp_name, ppStr "{-", pp_u, ppStr "-}"]
= case sty of
PprInterface -> pp_u
_ -> ppBesides [pp_name, ppStr "{-", pp_u, ppStr "-}"]
- where
+ where
pp_u = pprUnique uniq
pp_name = case name of
Just n -> pprOccName sty (getOccName n)
pp_u = pprUnique uniq
pp_name = case name of
Just n -> pprOccName sty (getOccName n)
@@
-291,7
+291,8
@@
We print type-variable binders with their kinds in interface files.
\begin{code}
pprTyVarBndr sty@PprInterface tyvar@(TyVar uniq kind name usage)
| not (isBoxedTypeKind kind)
\begin{code}
pprTyVarBndr sty@PprInterface tyvar@(TyVar uniq kind name usage)
| not (isBoxedTypeKind kind)
- = ppBesides [pprGenTyVar sty tyvar, ppStr "::", pprParendKind kind]
+ = ppBesides [pprGenTyVar sty tyvar, ppStr " :: ", pprParendKind kind]
+ -- See comments with ppDcolon in PprCore.lhs
pprTyVarBndr sty tyvar = pprGenTyVar sty tyvar
\end{code}
pprTyVarBndr sty tyvar = pprGenTyVar sty tyvar
\end{code}
@@
-355,11
+356,11
@@
pprTyCon sty (SpecTyCon tc ty_maybes)
pprTyCon sty (SynTyCon uniq name kind arity tyvars expansion)
= ppBeside (ppr sty name)
(ifPprShowAll sty
pprTyCon sty (SynTyCon uniq name kind arity tyvars expansion)
= ppBeside (ppr sty name)
(ifPprShowAll sty
- (ppCat [ ppStr " {-",
+ (ppCat [ ppPStr SLIT(" {-"),
ppInt arity,
interpp'SP sty tyvars,
pprParendGenType sty expansion,
ppInt arity,
interpp'SP sty tyvars,
pprParendGenType sty expansion,
- ppStr "-}"]))
+ ppPStr SLIT("-}")]))
-}
\end{code}
-}
\end{code}
@@
-404,7
+405,7
@@
ppr_class_op sty tyvars (ClassOp op_name i ty)
getTypeString :: Type -> FAST_STRING
getTypeString ty
getTypeString :: Type -> FAST_STRING
getTypeString ty
- = case (splitAppTy ty) of { (tc, args) ->
+ = case (splitAppTys ty) of { (tc, args) ->
_CONCAT_ (do_tc tc : map do_arg_ty args) }
where
do_tc (TyConTy tc _) = nameString (getName tc)
_CONCAT_ (do_tc tc : map do_arg_ty args) }
where
do_tc (TyConTy tc _) = nameString (getName tc)
@@
-536,7
+537,7
@@
nmbrTyVar tv@(TyVar u _ _ _) nenv@(NmbrEnv ui ut uu idenv tvenv uvenv)
= case (lookupUFM_Directly tvenv u) of
Just xx -> (nenv, xx)
Nothing ->
= case (lookupUFM_Directly tvenv u) of
Just xx -> (nenv, xx)
Nothing ->
- --pprTrace "nmbrTyVar: lookup failed:" (ppCat (ppr PprDebug u : [ppCat [ppr PprDebug x, ppStr "=>", ppr PprDebug tv] | (x,tv) <- ufmToList tvenv])) $
+ --pprTrace "nmbrTyVar: lookup failed:" (ppCat (ppr PprDebug u : [ppCat [ppr PprDebug x, ppPStr SLIT("=>"), ppr PprDebug tv] | (x,tv) <- ufmToList tvenv])) $
(nenv, tv)
\end{code}
(nenv, tv)
\end{code}