summaryrefslogtreecommitdiff
path: root/compiler/llvmGen/Llvm/Types.hs
diff options
context:
space:
mode:
authorDavid Terei <davidterei@gmail.com>2010-06-25 11:57:29 +0000
committerDavid Terei <davidterei@gmail.com>2010-06-25 11:57:29 +0000
commit14c1d88f583c0f1110b87d4396e0b7063fac231b (patch)
tree10d015474d235152ad9af0f7905c182a7f394b88 /compiler/llvmGen/Llvm/Types.hs
parentcf1c939d4693519e4f23c0f4fcbe60f1e04adf3e (diff)
downloadhaskell-14c1d88f583c0f1110b87d4396e0b7063fac231b.tar.gz
LLVM: Fix bug with calling tail with empty list
Diffstat (limited to 'compiler/llvmGen/Llvm/Types.hs')
-rw-r--r--compiler/llvmGen/Llvm/Types.hs22
1 files changed, 14 insertions, 8 deletions
diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index 50b365676e..4956d8d5af 100644
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -58,10 +58,13 @@ instance Show LlvmType where
show (LMStruct tys ) = "{" ++ (commaCat tys) ++ "}"
show (LMFunction (LlvmFunctionDecl _ _ _ r varg p _))
- = let varg' = if varg == VarArgs then ", ..." else ""
- args = (tail.concat) $
+ = let args = ((drop 1).concat) $ -- use drop since it can handle empty lists
map (\(t,a) -> "," ++ show t ++ " " ++ spaceCat a) p
- in show r ++ " (" ++ args ++ varg' ++ ")"
+ varg' = case varg of
+ VarArgs | not (null args) -> ", ..."
+ | otherwise -> "..."
+ _otherwise -> ""
+ in show r ++ " (" ++ args ++ varg' ++ ")"
show (LMAlias s _ ) = "%" ++ unpackFS s
@@ -351,14 +354,17 @@ data LlvmFunctionDecl = LlvmFunctionDecl {
instance Show LlvmFunctionDecl where
show (LlvmFunctionDecl n l c r varg p a)
- = let varg' = if varg == VarArgs then ", ..." else ""
+ = let args = ((drop 1).concat) $ -- use drop since it can handle empty lists
+ map (\(t,a) -> "," ++ show t ++ " " ++ spaceCat a) p
+ varg' = case varg of
+ VarArgs | not (null args) -> ", ..."
+ | otherwise -> "..."
+ _otherwise -> ""
align = case a of
Just a' -> " align " ++ show a'
Nothing -> ""
- args = (tail.concat) $
- map (\(t,a) -> "," ++ show t ++ " " ++ spaceCat a) p
- in show l ++ " " ++ show c ++ " " ++ show r ++ " @" ++ unpackFS n ++
- "(" ++ args ++ varg' ++ ")" ++ align
+ in show l ++ " " ++ show c ++ " " ++ show r ++ " @" ++ unpackFS n ++
+ "(" ++ args ++ varg' ++ ")" ++ align
type LlvmFunctionDecls = [LlvmFunctionDecl]