diff options
| author | Geoffrey Mainland <gmainlan@microsoft.com> | 2013-08-21 12:57:54 +0100 |
|---|---|---|
| committer | Geoffrey Mainland <gmainlan@microsoft.com> | 2013-09-22 22:33:59 -0400 |
| commit | da5a647c0c49fee7531ef4c076b1c9e6a9d0fe6d (patch) | |
| tree | 578570991e7336dcd44ea3acaa330a47bbb51787 | |
| parent | 0f89b9e293b7fe90121a4aed3ebba8501394b870 (diff) | |
| download | haskell-da5a647c0c49fee7531ef4c076b1c9e6a9d0fe6d.tar.gz | |
Do not expose LLVM-only primops in GHC.PrimopWrappers.
GHC.PrimopWrappers is only used by GHCi, which cannot evaluate LLVM-only
primops in any case.
| -rw-r--r-- | utils/genprimopcode/Main.hs | 27 |
1 files changed, 7 insertions, 20 deletions
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 5e1c9ab84b..a9f6a2a5fd 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -525,20 +525,15 @@ gen_wrappers (Info _ entries) ++ "module GHC.PrimopWrappers where\n" ++ "import qualified GHC.Prim\n" ++ "import GHC.Tuple ()\n" - ++ "import GHC.Prim (" ++ concat (intersperse ", " othertycons) ++ ")\n" - ++ "#if defined (__GLASGOW_HASKELL_LLVM__)\n" - ++ "import GHC.Prim (" ++ concat (intersperse ", " vectycons) ++ ")\n" - ++ "#endif /* defined (__GLASGOW_HASKELL_LLVM__) */\n" - ++ unlines (concatMap f otherspecs) - ++ "#if defined (__GLASGOW_HASKELL_LLVM__)\n" - ++ unlines (concatMap f vecspecs) - ++ "#endif /* defined (__GLASGOW_HASKELL_LLVM__) */\n" + ++ "import GHC.Prim (" ++ types ++ ")\n" + ++ unlines (concatMap f specs) where - specs = filter (not.dodgy) (filter is_primop entries) - (vecspecs, otherspecs) = partition is_llvm_only specs + specs = filter (not.dodgy) $ + filter (not.is_llvm_only) $ + filter is_primop entries tycons = foldr union [] $ map (tyconsIn . ty) specs - (vectycons, othertycons) = - (partition llvmOnlyTyCon . filter (`notElem` ["()", "Bool"])) tycons + tycons' = filter (`notElem` ["()", "Bool"]) tycons + types = concat $ intersperse ", " tycons' f spec = let args = map (\n -> "a" ++ show n) [1 .. arity (ty spec)] src_name = wrap (name spec) lhs = src_name ++ " " ++ unwords args @@ -565,14 +560,6 @@ gen_wrappers (Info _ entries) Just (OptionTrue _) -> True _ -> False - llvmOnlyTyCon :: TyCon -> Bool - llvmOnlyTyCon "Int32#" = True - llvmOnlyTyCon "FloatX4#" = True - llvmOnlyTyCon "DoubleX2#" = True - llvmOnlyTyCon "Int32X4#" = True - llvmOnlyTyCon "Int64X2#" = True - llvmOnlyTyCon _ = False - gen_primop_list :: Info -> String gen_primop_list (Info _ entries) = unlines ( |