[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
 
-import Ubiq
+IMP_Ubiq()
 
 -- friends:
-import HsLoop          ( nullMonoBinds, MonoBinds, Sig )
+IMPORT_DELOOPER(HsLoop)                ( nullMonoBinds, MonoBinds, Sig )
 import HsPragmas       ( DataPragmas, ClassPragmas,
-                         InstancePragmas, ClassOpPragmas )
+                         InstancePragmas, ClassOpPragmas
+                       )
 import HsTypes
 
 -- others:
-import Outputable
+import Name            ( pprSym, pprNonSym )
+import Outputable      ( interppSP, interpp'SP,
+                         Outputable(..){-instance * []-}
+                       )
 import Pretty
 import SrcLoc          ( SrcLoc )
-import Util            ( cmpList, panic#{-ToDo:rm eventually-} )
+--import Util          ( panic#{-ToDo:rm eventually-} )
 \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
-  = 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}
 
 %************************************************************************
@@ -164,27 +168,27 @@ data ConDecl 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 _)
-      = 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 _)
-      = 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 _)
-      = ppCat [pprNonOp sty con, pprParendMonoType sty ty]
+      = ppCat [pprNonSym sty con, pprParendMonoType sty ty]
     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]
 
-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}
 
 %************************************************************************
@@ -243,8 +247,8 @@ data InstDecl tyvar uvar name pat
                                -- 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
@@ -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
 
-    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