projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1996-07-19 18:36:04 by partain]
[ghc-hetmet.git]
/
ghc
/
compiler
/
hsSyn
/
HsDecls.lhs
diff --git
a/ghc/compiler/hsSyn/HsDecls.lhs
b/ghc/compiler/hsSyn/HsDecls.lhs
index
6952ef0
..
6341f66
100644
(file)
--- a/
ghc/compiler/hsSyn/HsDecls.lhs
+++ b/
ghc/compiler/hsSyn/HsDecls.lhs
@@
-11,19
+11,23
@@
Definitions for: @FixityDecl@, @TyDecl@ and @ConDecl@, @ClassDecl@,
module HsDecls where
module HsDecls where
-import Ubiq
+IMP_Ubiq()
-- friends:
-- friends:
-import HsLoop ( nullMonoBinds, MonoBinds, Sig )
+IMPORT_DELOOPER(HsLoop) ( nullMonoBinds, MonoBinds, Sig )
import HsPragmas ( DataPragmas, ClassPragmas,
import HsPragmas ( DataPragmas, ClassPragmas,
- InstancePragmas, ClassOpPragmas )
+ InstancePragmas, ClassOpPragmas
+ )
import HsTypes
-- others:
import HsTypes
-- others:
-import Outputable
+import Name ( pprSym, pprNonSym )
+import Outputable ( interppSP, interpp'SP,
+ Outputable(..){-instance * []-}
+ )
import Pretty
import SrcLoc ( SrcLoc )
import Pretty
import SrcLoc ( SrcLoc )
-import Util ( cmpList, panic#{-ToDo:rm eventually-} )
+--import Util ( panic#{-ToDo:rm eventually-} )
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-47,7
+51,7
@@
instance (NamedThing name, Outputable name)
ppr sty (InfixN var prec) = print_it sty "" prec var
print_it sty suff prec var
ppr sty (InfixN var prec) = print_it sty "" prec var
print_it sty suff prec var
- = ppBesides [ppStr "infix", ppStr suff, ppSP, ppInt prec, ppSP, pprOp sty var]
+ = ppBesides [ppStr "infix", ppStr suff, ppSP, ppInt prec, ppSP, pprSym sty var]
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-164,27
+168,27
@@
data ConDecl name
SrcLoc
data BangType name
SrcLoc
data BangType name
- = Banged (MonoType name)
- | Unbanged (MonoType name)
+ = Banged (PolyType name) -- PolyType: to allow Haskell extensions
+ | Unbanged (PolyType name) -- (MonoType only needed for straight Haskell)
\end{code}
\begin{code}
instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
ppr sty (ConDecl con tys _)
\end{code}
\begin{code}
instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
ppr sty (ConDecl con tys _)
- = ppCat [pprNonOp sty con, ppInterleave ppNil (map (ppr_bang sty) tys)]
+ = ppCat [pprNonSym sty con, ppInterleave ppNil (map (ppr_bang sty) tys)]
ppr sty (ConOpDecl ty1 op ty2 _)
ppr sty (ConOpDecl ty1 op ty2 _)
- = ppCat [ppr_bang sty ty1, pprOp sty op, ppr_bang sty ty2]
+ = ppCat [ppr_bang sty ty1, pprSym sty op, ppr_bang sty ty2]
ppr sty (NewConDecl con ty _)
ppr sty (NewConDecl con ty _)
- = ppCat [pprNonOp sty con, pprParendMonoType sty ty]
+ = ppCat [pprNonSym sty con, pprParendMonoType sty ty]
ppr sty (RecConDecl con fields _)
ppr sty (RecConDecl con fields _)
- = ppCat [pprNonOp sty con, ppChar '{',
+ = ppCat [pprNonSym sty con, ppChar '{',
ppInterleave pp'SP (map pp_field fields), ppChar '}']
where
pp_field (n, ty) = ppCat [ppr sty n, ppPStr SLIT("::"), ppr_bang sty ty]
ppInterleave pp'SP (map pp_field fields), ppChar '}']
where
pp_field (n, ty) = ppCat [ppr sty n, ppPStr SLIT("::"), ppr_bang sty ty]
-ppr_bang sty (Banged ty) = ppBeside (ppChar '!') (pprParendMonoType sty ty)
-ppr_bang sty (Unbanged ty) = pprParendMonoType sty ty
+ppr_bang sty (Banged ty) = ppBeside (ppChar '!') (pprParendPolyType sty ty)
+ppr_bang sty (Unbanged ty) = pprParendPolyType sty ty
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-243,8
+247,8
@@
data InstDecl tyvar uvar name pat
-- module being compiled; False <=> It is from
-- an imported interface.
-- module being compiled; False <=> It is from
-- an imported interface.
- (Maybe Module) -- The name of the module where the instance decl
- -- originally came from; Nothing => Prelude
+ Module -- The name of the module where the instance decl
+ -- originally came from
[Sig name] -- actually user-supplied pragmatic info
(InstancePragmas name) -- interface-supplied pragmatic info
[Sig name] -- actually user-supplied pragmatic info
(InstancePragmas name) -- interface-supplied pragmatic info
@@
-256,7
+260,7
@@
instance (NamedThing name, Outputable name, Outputable pat,
Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
=> Outputable (InstDecl tyvar uvar name pat) where
Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
=> Outputable (InstDecl tyvar uvar name pat) where
- ppr sty (InstDecl clas ty binds local modname uprags pragmas src_loc)
+ ppr sty (InstDecl clas ty binds from_here modname uprags pragmas src_loc)
= let
(context, inst_ty)
= case ty of
= let
(context, inst_ty)
= case ty of