FIX #1861: floating-point constants for infinity and NaN in via-C

[ghc-hetmet.git] / compiler / cmm / PprC.hs

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 3673e7c..9a3a3a2 100644 (file)
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -34,6 +34,7 @@ module PprC (
 
 -- Cmm stuff
 import Cmm
+import PprCmm  ()      -- Instances only
 import CLabel
 import MachOp
 import ForeignCall
@@ -240,9 +241,9 @@ pprCFunType ppr_fn cconv ress args
     parens (commafy (map arg_type args))
   where
        res_type [] = ptext (sLit "void")
-       res_type [CmmHinted one hint] = machRepHintCType (localRegRep one) hint
+       res_type [CmmKinded one hint] = machRepHintCType (localRegRep one) hint
 
-       arg_type (CmmHinted expr hint) = machRepHintCType (cmmExprRep expr) hint
+       arg_type (CmmKinded expr hint) = machRepHintCType (cmmExprRep expr) hint
 
 -- ---------------------------------------------------------------------
 -- unconditional branches
@@ -394,7 +395,16 @@ pprMachOpApp' mop args
 pprLit :: CmmLit -> SDoc
 pprLit lit = case lit of
     CmmInt i rep      -> pprHexVal i rep
-    CmmFloat f rep     -> parens (machRepCType rep) <> (rational f)
+
+    CmmFloat f rep     -> parens (machRepCType rep) <> str
+        where d = fromRational f :: Double
+              str | isInfinite d && d < 0 = ptext (sLit "-INFINITY")
+                  | isInfinite d          = ptext (sLit "INFINITY")
+                  | isNaN d               = ptext (sLit "NAN")
+                  | otherwise             = text (show d)
+                -- these constants come from <math.h>
+                -- see #1861
+
     CmmLabel clbl      -> mkW_ <> pprCLabelAddr clbl
     CmmLabelOff clbl i -> mkW_ <> pprCLabelAddr clbl <> char '+' <> int i
     CmmLabelDiffOff clbl1 clbl2 i
@@ -750,16 +760,16 @@ pprCall ppr_fn cconv results args _
     ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi
   where 
      ppr_assign []           rhs = rhs
-     ppr_assign [CmmHinted one hint] rhs
+     ppr_assign [CmmKinded one hint] rhs
         = pprLocalReg one <> ptext (sLit " = ")
                 <> pprUnHint hint (localRegRep one) <> rhs
      ppr_assign _other _rhs = panic "pprCall: multiple results"
 
-     pprArg (CmmHinted expr hint)
+     pprArg (CmmKinded expr hint)
          | hint `elem` [PtrHint,SignedHint]
          = cCast (machRepHintCType (cmmExprRep expr) hint) expr
        -- see comment by machRepHintCType below
-     pprArg (CmmHinted expr _other)
+     pprArg (CmmKinded expr _other)
          = pprExpr expr
 
      pprUnHint PtrHint    rep = parens (machRepCType rep)
@@ -843,8 +853,8 @@ te_Lit _ = return ()
 te_Stmt :: CmmStmt -> TE ()
 te_Stmt (CmmAssign r e)                = te_Reg r >> te_Expr e
 te_Stmt (CmmStore l r)         = te_Expr l >> te_Expr r
-te_Stmt (CmmCall _ rs es _ _)  = mapM_ (te_temp.hintlessCmm) rs >>
-                                 mapM_ (te_Expr.hintlessCmm) es
+te_Stmt (CmmCall _ rs es _ _)  = mapM_ (te_temp.kindlessCmm) rs >>
+                                 mapM_ (te_Expr.kindlessCmm) es
 te_Stmt (CmmCondBranch e _)    = te_Expr e
 te_Stmt (CmmSwitch e _)                = te_Expr e
 te_Stmt (CmmJump e _)          = te_Expr e