[commit: ghc] master: genprimopcode: Don't output tabs (a2d2546)

git at git.haskell.org git at git.haskell.org
Wed Aug 20 12:23:23 UTC 2014


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a2d25464bc79102bd81b7889cec9bf534c1c8864/ghc

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

commit a2d25464bc79102bd81b7889cec9bf534c1c8864
Author: Austin Seipp <austin at well-typed.com>
Date:   Wed Aug 20 07:12:01 2014 -0500

    genprimopcode: Don't output tabs
    
    Otherwise the build breaks, because its output is included in tab-free
    files. See ef9dd9f.
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


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

a2d25464bc79102bd81b7889cec9bf534c1c8864
 utils/genprimopcode/Main.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index 7fe375a..bb40917 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -242,7 +242,7 @@ gen_hs_source (Info defaults entries) =
         ++ "-----------------------------------------------------------------------------\n"
         ++ "{-# LANGUAGE MagicHash, MultiParamTypeClasses, NoImplicitPrelude, UnboxedTuples #-}\n"
         ++ "module GHC.Prim (\n"
-        ++ unlines (map (("\t" ++) . hdr) entries')
+        ++ unlines (map (("        " ++) . hdr) entries')
         ++ ") where\n"
     ++ "\n"
     ++ "{-\n"
@@ -735,7 +735,7 @@ gen_primop_vector_tys_exports (Info _ entries)
 
     mkVecTypes :: Entry -> String
     mkVecTypes i =
-        "\t" ++ ty_id ++ ", " ++ tycon_id ++ ","
+        "        " ++ ty_id ++ ", " ++ tycon_id ++ ","
       where
         ty_id    = prefix i ++ "PrimTy"
         tycon_id = prefix i ++ "PrimTyCon"



More information about the ghc-commits mailing list