[project @ 1996-05-01 18:36:59 by partain]

[ghc-hetmet.git] / ghc / compiler / hsSyn / HsBinds.lhs

diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs
index 15dafc9..a725c1d 100644 (file)
--- a/ghc/compiler/hsSyn/HsBinds.lhs
+++ b/ghc/compiler/hsSyn/HsBinds.lhs
@@ -22,7 +22,7 @@ import HsTypes                ( PolyType )
 
 --others:
 import Id              ( DictVar(..), Id(..), GenId )
-import Name            ( pprNonOp )
+import Name            ( pprNonSym )
 import Outputable      ( interpp'SP, ifnotPprForUser,
                          Outputable(..){-instance * (,)-}
                        )
@@ -151,31 +151,31 @@ data Sig name
 \begin{code}
 instance (NamedThing name, Outputable name) => Outputable (Sig name) where
     ppr sty (Sig var ty pragmas _)
-      = ppHang (ppCat [pprNonOp sty var, ppPStr SLIT("::")])
+      = ppHang (ppCat [pprNonSym sty var, ppPStr SLIT("::")])
             4 (ppHang (ppr sty ty)
                     4 (ifnotPprForUser sty (ppr sty pragmas)))
 
     ppr sty (ClassOpSig var ty pragmas _)
-      = ppHang (ppCat [pprNonOp sty var, ppPStr SLIT("::")])
+      = ppHang (ppCat [pprNonSym sty var, ppPStr SLIT("::")])
             4 (ppHang (ppr sty ty)
                     4 (ifnotPprForUser sty (ppr sty pragmas)))
 
     ppr sty (DeforestSig var _)
-      = ppHang (ppCat [ppStr "{-# DEFOREST", pprNonOp sty var])
+      = ppHang (ppCat [ppStr "{-# DEFOREST", pprNonSym sty var])
                   4 (ppStr "#-}")
 
     ppr sty (SpecSig var ty using _)
-      = ppHang (ppCat [ppPStr SLIT("{-# SPECIALIZE"), pprNonOp sty var, ppPStr SLIT("::")])
+      = ppHang (ppCat [ppPStr SLIT("{-# SPECIALIZE"), pprNonSym sty var, ppPStr SLIT("::")])
             4 (ppCat [ppr sty ty, pp_using using, ppPStr SLIT("#-}")])
       where
        pp_using Nothing   = ppNil
        pp_using (Just me) = ppCat [ppChar '=', ppr sty me]
 
     ppr sty (InlineSig var _)
-      = ppCat [ppPStr SLIT("{-# INLINE"), pprNonOp sty var, ppPStr SLIT("#-}")]
+      = ppCat [ppPStr SLIT("{-# INLINE"), pprNonSym sty var, ppPStr SLIT("#-}")]
 
     ppr sty (MagicUnfoldingSig var str _)
-      = ppCat [ppPStr SLIT("{-# MAGIC_UNFOLDING"), pprNonOp sty var, ppPStr str, ppPStr SLIT("#-}")]
+      = ppCat [ppPStr SLIT("{-# MAGIC_UNFOLDING"), pprNonSym sty var, ppPStr str, ppPStr SLIT("#-}")]
 \end{code}
 
 %************************************************************************
@@ -237,6 +237,7 @@ data MonoBinds tyvar uvar id pat
                    (GRHSsAndBinds tyvar uvar id pat)
                    SrcLoc
   | FunMonoBind     id
+                   Bool                        -- True => infix declaration
                    [Match tyvar uvar id pat]   -- must have at least one Match
                    SrcLoc
   | VarMonoBind            id                  -- TRANSLATION
@@ -262,11 +263,12 @@ instance (NamedThing id, Outputable id, Outputable pat,
     ppr sty (PatMonoBind pat grhss_n_binds locn)
       = ppHang (ppr sty pat) 4 (pprGRHSsAndBinds sty False grhss_n_binds)
 
-    ppr sty (FunMonoBind fun matches locn)
-      = pprMatches sty (False, pprNonOp sty fun) matches
+    ppr sty (FunMonoBind fun inf matches locn)
+      = pprMatches sty (False, pprNonSym sty fun) matches
+      -- ToDo: print infix if appropriate
 
     ppr sty (VarMonoBind name expr)
-      = ppHang (ppCat [pprNonOp sty name, ppEquals]) 4 (ppr sty expr)
+      = ppHang (ppCat [pprNonSym sty name, ppEquals]) 4 (ppr sty expr)
 \end{code}
 
 %************************************************************************
@@ -302,7 +304,7 @@ collectBinders (RecBind monobinds)    = collectMonoBinders monobinds
 collectMonoBinders :: MonoBinds tyvar uvar name (InPat name) -> [name]
 collectMonoBinders EmptyMonoBinds                   = []
 collectMonoBinders (PatMonoBind pat grhss_w_binds _) = collectPatBinders pat
-collectMonoBinders (FunMonoBind f matches _)        = [f]
+collectMonoBinders (FunMonoBind f _ matches _)      = [f]
 collectMonoBinders (VarMonoBind v expr)             = error "collectMonoBinders"
 collectMonoBinders (AndMonoBinds bs1 bs2)
  = collectMonoBinders bs1 ++ collectMonoBinders bs2
@@ -321,7 +323,7 @@ collectMonoBindersAndLocs (AndMonoBinds bs1 bs2)
 collectMonoBindersAndLocs (PatMonoBind pat grhss_w_binds locn)
   = collectPatBinders pat `zip` repeat locn
 
-collectMonoBindersAndLocs (FunMonoBind f matches locn) = [(f, locn)]
+collectMonoBindersAndLocs (FunMonoBind f _ matches locn) = [(f, locn)]
 
 #ifdef DEBUG
 collectMonoBindersAndLocs (VarMonoBind v expr)