diff options
author | David Terei <davidterei@gmail.com> | 2010-06-25 11:57:29 +0000 |
---|---|---|
committer | David Terei <davidterei@gmail.com> | 2010-06-25 11:57:29 +0000 |
commit | 14c1d88f583c0f1110b87d4396e0b7063fac231b (patch) | |
tree | 10d015474d235152ad9af0f7905c182a7f394b88 /compiler/llvmGen/Llvm/Types.hs | |
parent | cf1c939d4693519e4f23c0f4fcbe60f1e04adf3e (diff) | |
download | haskell-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.hs | 22 |
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] |