Do not #include external header files when compiling via C

This has several advantages:

 - -fvia-C is consistent with -fasm with respect to FFI declarations:
   both bind to the ABI, not the API.

 - foreign calls can now be inlined freely across module boundaries, since
   a header file is not required when compiling the call.

 - bootstrapping via C will be more reliable, because this difference
   in behavour between the two backends has been removed.

There is one disadvantage:

 - we get no checking by the C compiler that the FFI declaration
   is correct.

So now, the c-includes field in a .cabal file is always ignored by
GHC, as are header files specified in an FFI declaration.  This was
previously the case only for -fasm compilations, now it is also the
case for -fvia-C too.

3 files changed, 53 insertions, 31 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 751575b0d1..a3c2634e35 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -105,6 +105,7 @@ module CLabel (
 
 	infoLblToEntryLbl, entryLblToInfoLbl,
 	needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
+        isMathFun,
 	CLabelType(..), labelType, labelDynamic,
 
 	pprCLabel
@@ -462,7 +463,11 @@ needsCDecl ModuleRegdLabel		= False
 needsCDecl (StringLitLabel _)		= False
 needsCDecl (AsmTempLabel _)		= False
 needsCDecl (RtsLabel _)			= False
-needsCDecl (ForeignLabel _ _ _)		= False
+  -- RTS labels are declared in RTS header files.  Otherwise we'd need
+  -- to give types for each label reference in the RTS .cmm files
+  -- somehow; when generating .cmm code we know the types of labels (info, 
+  -- entry etc.) but for hand-written .cmm code we don't.
+needsCDecl l@(ForeignLabel _ _ _)	= not (isMathFun l)
 needsCDecl (CC_Label _)			= True
 needsCDecl (CCS_Label _)		= True
 needsCDecl (HpcTicksLabel _)            = True
@@ -478,6 +483,25 @@ maybeAsmTemp :: CLabel -> Maybe Unique
 maybeAsmTemp (AsmTempLabel uq) = Just uq
 maybeAsmTemp _ 	    	       = Nothing
 
+-- some labels have C prototypes in scope when compiling via C, because
+-- they are builtin to the C compiler.  For these labels we avoid
+-- generating our own C prototypes.
+isMathFun :: CLabel -> Bool
+isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
+  where
+  math_funs = [
+        FSLIT("pow"),    FSLIT("sin"),   FSLIT("cos"),
+        FSLIT("tan"),    FSLIT("sinh"),  FSLIT("cosh"),
+        FSLIT("tanh"),   FSLIT("asin"),  FSLIT("acos"),
+        FSLIT("atan"),   FSLIT("log"),   FSLIT("exp"),
+        FSLIT("sqrt"),   FSLIT("powf"),  FSLIT("sinf"),
+        FSLIT("cosf"),   FSLIT("tanf"),  FSLIT("sinhf"),
+        FSLIT("coshf"),  FSLIT("tanhf"), FSLIT("asinf"),
+        FSLIT("acosf"),  FSLIT("atanf"), FSLIT("logf"),
+        FSLIT("expf"),   FSLIT("sqrtf")
+   ]
+isMathFun _ = False
+
 -- -----------------------------------------------------------------------------
 -- Is a CLabel visible outside this object file or not?
 
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 70cd7c4c5b..d387bf0465 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -200,7 +200,9 @@ static 	:: { ExtFCode [CmmStatic] }
 	| 'CLOSURE' '(' NAME lits ')'
 		{ do lits <- sequence $4;
 		     return $ map CmmStaticLit $
-		       mkStaticClosure (mkRtsInfoLabelFS $3) 
+                       mkStaticClosure (mkForeignLabel $3 Nothing True)
+                         -- mkForeignLabel because these are only used
+                         -- for CHARLIKE and INTLIKE closures in the RTS.
 			 dontCareCCS (map getLit lits) [] [] [] }
 	-- arrays of closures required for the CHARLIKE & INTLIKE arrays
 
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index ceadebe8e7..e46e0e7f89 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -201,25 +201,24 @@ pprStmt stmt = case stmt of
 	  rep = cmmExprRep src
 
     CmmCall (CmmCallee fn cconv) results args safety _ret ->
-	-- Controversial: leave this out for now.
-	-- pprUndef fn $$
-
+        maybe_proto $$
 	pprCall ppr_fn cconv results args safety
 	where
-    	ppr_fn = case fn of
-		   CmmLit (CmmLabel lbl) -> pprCLabel lbl
-		   _ -> parens (cCast (pprCFunType cconv results args) fn)
-			-- for a dynamic call, cast the expression to
-			-- a function of the right type (we hope).
-
-	-- we #undef a function before calling it: the FFI is supposed to be
-	-- an interface specifically to C, not to C+CPP.  For one thing, this
-	-- makes the via-C route more compatible with the NCG.  If macros
-	-- are being used for optimisation, then inline functions are probably
-	-- better anyway.
-	pprUndef (CmmLit (CmmLabel lbl)) = 
-	   ptext SLIT("#undef") <+> pprCLabel lbl
-	pprUndef _ = empty
+        ppr_fn = parens (cCast (pprCFunType (char '*') cconv results args) fn)
+
+    	maybe_proto = 
+            case fn of
+	      CmmLit (CmmLabel lbl) | not (isMathFun lbl) -> 
+                  ptext SLIT(";EI_(") <+> pprCLabel lbl <> char ')' <> semi
+                        -- we declare all called functions as data labels,
+                        -- and then cast them to the right type when calling.
+                        -- This is because the label might already have a 
+                        -- declaration as a data label in the same file,
+                        -- e.g. Foreign.Marshal.Alloc declares 'free' as
+                        -- both a data label and a function label.
+	      _ -> 
+                   empty {- no proto -}
+			-- for a dynamic call, no declaration is necessary.
 
     CmmCall (CmmPrim op) results args safety _ret ->
 	pprCall ppr_fn CCallConv results args safety
@@ -231,13 +230,11 @@ pprStmt stmt = case stmt of
     CmmJump lbl _params      -> mkJMP_(pprExpr lbl) <> semi
     CmmSwitch arg ids        -> pprSwitch arg ids
 
-pprCFunType :: CCallConv -> CmmFormals -> CmmActuals -> SDoc
-pprCFunType cconv ress args
-  = hcat [
-	res_type ress,
-	parens (text (ccallConvAttribute cconv) <>  char '*'),
-	parens (commafy (map arg_type args))
-   ]
+pprCFunType :: SDoc -> CCallConv -> CmmFormals -> CmmActuals -> SDoc
+pprCFunType ppr_fn cconv ress args
+  = res_type ress <+>
+    parens (text (ccallConvAttribute cconv) <>  ppr_fn) <>
+    parens (commafy (map arg_type args))
   where
 	res_type [] = ptext SLIT("void")
 	res_type [CmmHinted one hint] = machRepHintCType (localRegRep one) hint
@@ -755,13 +752,12 @@ pprCall ppr_fn cconv results args _
 		 <> pprUnHint hint (localRegRep one) <> rhs
      ppr_assign _other _rhs = panic "pprCall: multiple results"
 
-     pprArg (CmmHinted expr PtrHint)
-   	= cCast (ptext SLIT("void *")) expr
+     pprArg (CmmHinted expr hint)
+         | hint `elem` [PtrHint,SignedHint]
+         = cCast (machRepHintCType (cmmExprRep expr) hint) expr
 	-- see comment by machRepHintCType below
-     pprArg (CmmHinted expr SignedHint)
-	= cCast (machRepSignedCType (cmmExprRep expr)) expr
      pprArg (CmmHinted expr _other)
-	= pprExpr expr
+         = pprExpr expr
 
      pprUnHint PtrHint    rep = parens (machRepCType rep)
      pprUnHint SignedHint rep = parens (machRepCType rep)