[commit: ghc] wip/erikd-build: Fix the non-Linux build (4c982cd)

git at git.haskell.org git at git.haskell.org
Fri Jul 22 11:07:13 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/erikd-build
Link       : http://ghc.haskell.org/trac/ghc/changeset/4c982cd4b5ef265fc09fb15e009600b04bb9d77c/ghc

>---------------------------------------------------------------

commit 4c982cd4b5ef265fc09fb15e009600b04bb9d77c
Author: Erik de Castro Lopo <erikd at mega-nerd.com>
Date:   Thu Jul 21 20:42:22 2016 +1000

    Fix the non-Linux build
    
    * rts/sm/CNF.c: Drop un-needed #includes.
    * Fix parenthesis usage with CPP ASSERT macro.
    * Fix format string in debugBelch messages.


>---------------------------------------------------------------

4c982cd4b5ef265fc09fb15e009600b04bb9d77c
 compiler/simplStg/UnariseStg.hs | 16 ++++++++--------
 compiler/stgSyn/CoreToStg.hs    |  2 +-
 rts/sm/CNF.c                    |  6 ++----
 3 files changed, 11 insertions(+), 13 deletions(-)

diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs
index af2928d..24c0ce8 100644
--- a/compiler/simplStg/UnariseStg.hs
+++ b/compiler/simplStg/UnariseStg.hs
@@ -241,10 +241,10 @@ instance Outputable UnariseVal where
 -- | Extend the environment, checking the UnariseEnv invariant.
 extendRho :: UnariseEnv -> Id -> UnariseVal -> UnariseEnv
 extendRho rho x (MultiVal args)
-  = ASSERT (all (isNvUnaryType . stgArgType) args)
+  = ASSERT(all (isNvUnaryType . stgArgType) args)
     extendVarEnv rho x (MultiVal args)
 extendRho rho x (UnaryVal val)
-  = ASSERT (isNvUnaryType (stgArgType val))
+  = ASSERT(isNvUnaryType (stgArgType val))
     extendVarEnv rho x (UnaryVal val)
 
 --------------------------------------------------------------------------------
@@ -273,7 +273,7 @@ unariseRhs rho (StgRhsClosure ccs b_info fvs update_flag args expr)
        return (StgRhsClosure ccs b_info fvs' update_flag args1 expr')
 
 unariseRhs rho (StgRhsCon ccs con args)
-  = ASSERT (not (isUnboxedTupleCon con || isUnboxedSumCon con))
+  = ASSERT(not (isUnboxedTupleCon con || isUnboxedSumCon con))
     return (StgRhsCon ccs con (unariseConArgs rho args))
 
 --------------------------------------------------------------------------------
@@ -356,7 +356,7 @@ unariseMulti_maybe rho dc args ty_args
   = Just (unariseConArgs rho args)
 
   | isUnboxedSumCon dc
-  , let args1 = ASSERT (isSingleton args) (unariseConArgs rho args)
+  , let args1 = ASSERT(isSingleton args) (unariseConArgs rho args)
   = Just (mkUbxSum dc ty_args args1)
 
   | otherwise
@@ -374,7 +374,7 @@ elimCase rho args bndr (MultiValAlt _) [(_, bndrs, rhs)]
              | isUnboxedTupleBndr bndr
              = mapTupleIdBinders bndrs args rho1
              | otherwise
-             = ASSERT (isUnboxedSumBndr bndr)
+             = ASSERT(isUnboxedSumBndr bndr)
                if null bndrs then rho1
                              else mapSumIdBinders bndrs args rho1
 
@@ -480,7 +480,7 @@ mapTupleIdBinders
   -> UnariseEnv
   -> UnariseEnv
 mapTupleIdBinders ids args0 rho0
-  = ASSERT (not (any (isVoidTy . stgArgType) args0))
+  = ASSERT(not (any (isVoidTy . stgArgType) args0))
     let
       ids_unarised :: [(Id, RepType)]
       ids_unarised = map (\id -> (id, repType (idType id))) ids
@@ -498,7 +498,7 @@ mapTupleIdBinders ids args0 rho0
             | isMultiRep x_rep
             = extendRho rho x (MultiVal x_args)
             | otherwise
-            = ASSERT (x_args `lengthIs` 1)
+            = ASSERT(x_args `lengthIs` 1)
               extendRho rho x (UnaryVal (head x_args))
         in
           map_ids rho' xs args'
@@ -514,7 +514,7 @@ mapSumIdBinders
   -> UnariseEnv
 
 mapSumIdBinders [id] args rho0
-  = ASSERT (not (any (isVoidTy . stgArgType) args))
+  = ASSERT(not (any (isVoidTy . stgArgType) args))
     let
       arg_slots = concatMap (repTypeSlots . repType . stgArgType) args
       id_slots  = repTypeSlots (repType (idType id))
diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs
index cba139a..d130b74 100644
--- a/compiler/stgSyn/CoreToStg.hs
+++ b/compiler/stgSyn/CoreToStg.hs
@@ -774,7 +774,7 @@ mkStgRhs' con_updateable rhs_fvs bndr binder_info rhs
   | StgConApp con args _ <- unticked_rhs
   , not (con_updateable con args)
   = -- CorePrep does this right, but just to make sure
-    ASSERT (not (isUnboxedTupleCon con || isUnboxedSumCon con))
+    ASSERT(not (isUnboxedTupleCon con || isUnboxedSumCon con))
     StgRhsCon noCCS con args
   | otherwise
   = StgRhsClosure noCCS binder_info
diff --git a/rts/sm/CNF.c b/rts/sm/CNF.c
index 3c681c2..9aeb36f 100644
--- a/rts/sm/CNF.c
+++ b/rts/sm/CNF.c
@@ -29,8 +29,6 @@
 #ifdef HAVE_LIMITS_H
 #include <limits.h>
 #endif
-#include <dlfcn.h>
-#include <endian.h>
 
 /**
  * Note [Compact Normal Forms]
@@ -977,7 +975,7 @@ spew_failing_pointer(StgWord *fixup_table, uint32_t count, StgWord address)
     bdescr *bd;
     StgWord size;
 
-    debugBelch("Failed to adjust 0x%lx. Block dump follows...\n",
+    debugBelch("Failed to adjust 0x%" FMT_HexWord ". Block dump follows...\n",
                address);
 
     for (i  = 0; i < count; i++) {
@@ -988,7 +986,7 @@ spew_failing_pointer(StgWord *fixup_table, uint32_t count, StgWord address)
         bd = Bdescr((P_)block);
         size = (W_)bd->free - (W_)bd->start;
 
-        debugBelch("%d: was 0x%lx-0x%lx, now 0x%lx-0x%lx\n", i,
+        debugBelch("%" FMT_Word32 ": was 0x%" FMT_HexWord "-0x%" FMT_HexWord ", now 0x%" FMT_HexWord "-0x%" FMT_HexWord "\n", i,
                    key, key+size, value, value+size);
     }
 }



More information about the ghc-commits mailing list