[project @ 1999-06-23 10:38:13 by simonmar]

[ghc-hetmet.git] / ghc / compiler / rename / RnExpr.lhs

diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index e483327..5e55fd0 100644 (file)
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -122,9 +122,12 @@ rnPat neg@(NegPatIn pat)
     rnPat pat          `thenRn` \ (pat', fvs) ->
     returnRn (NegPatIn pat', fvs)
   where
-    valid_neg_pat (LitPatIn (HsInt  _)) = True
-    valid_neg_pat (LitPatIn (HsFrac _)) = True
-    valid_neg_pat _                     = False
+    valid_neg_pat (LitPatIn (HsInt        _)) = True
+    valid_neg_pat (LitPatIn (HsIntPrim    _)) = True
+    valid_neg_pat (LitPatIn (HsFrac       _)) = True
+    valid_neg_pat (LitPatIn (HsFloatPrim  _)) = True
+    valid_neg_pat (LitPatIn (HsDoublePrim _)) = True
+    valid_neg_pat _                           = False
 
 rnPat (ParPatIn pat)
   = rnPat pat          `thenRn` \ (pat', fvs) ->
@@ -312,6 +315,12 @@ rnExpr (OpApp e1 op _ e2)
     returnRn (final_e,
              fv_e1 `plusFV` fv_op `plusFV` fv_e2)
 
+-- constant-fold some negate applications on unboxed literals.  Since
+-- negate is a polymorphic function, we have to do these here.
+rnExpr (NegApp (HsLit (HsIntPrim i))    _) = rnExpr (HsLit (HsIntPrim (-i)))
+rnExpr (NegApp (HsLit (HsFloatPrim i))  _) = rnExpr (HsLit (HsFloatPrim (-i)))
+rnExpr (NegApp (HsLit (HsDoublePrim i)) _) = rnExpr (HsLit (HsDoublePrim (-i)))
+
 rnExpr (NegApp e n)
   = rnExpr e                           `thenRn` \ (e', fv_e) ->
     lookupImplicitOccRn negate_RDR     `thenRn` \ neg ->
@@ -675,9 +684,10 @@ checkPrec op pat right
 \end{code}
 
 Consider
+\begin{verbatim}
        a `op1` b `op2` c
-
-(compareFixity op1 op2) tells which way to arrange appication, or
+\end{verbatim}
+@(compareFixity op1 op2)@ tells which way to arrange appication, or
 whether there's an error.
 
 \begin{code}
@@ -704,7 +714,8 @@ compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
 %*                                                                     *
 %************************************************************************
 
-When literals occur we have to make sure that the types and classes they involve
+When literals occur we have to make sure
+that the types and classes they involve
 are made available.
 
 \begin{code}
@@ -813,12 +824,13 @@ precParseErr op1 op2
               ptext SLIT("in the same infix expression")])
 
 nonStdGuardErr guard
-  = hang (ptext SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)"))
-      4 (ppr guard)
+  = hang (ptext
+    SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")
+    ) 4 (ppr guard)
 
 patSigErr ty
-  = hang (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
-        4 (ptext SLIT("Use -fglasgow-exts to permit it"))
+  =  (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
+       $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
 
 pp_op (op, fix) = hcat [ppr op, space, parens (ppr fix)]
 \end{code}