LLVM: Use packed structure type instead of structure type

[ghc-hetmet.git] / compiler / llvmGen / Llvm / Types.hs

diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index 50b3656..0a39d38 100644 (file)
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -55,13 +55,16 @@ instance Show LlvmType where
   show (LMArray nr tp ) = "[" ++ show nr ++ " x " ++ show tp ++ "]"
   show (LMLabel       ) = "label"
   show (LMVoid        ) = "void"
-  show (LMStruct tys  ) = "{" ++ (commaCat tys) ++ "}"
+  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
 
@@ -96,6 +99,10 @@ data LlvmLit
   = LMIntLit Integer LlvmType
   -- | Floating point literal
   | LMFloatLit Double LlvmType
+  -- | Literal NULL, only applicable to pointer types
+  | LMNullLit LlvmType
+  -- | Undefined value, random bit pattern. Useful for optimisations.
+  | LMUndefLit LlvmType
   deriving (Eq)
 
 instance Show LlvmLit where
@@ -137,9 +144,9 @@ instance Show LlvmStatic where
 
   show (LMStaticStruc d t)
       = let struc = case d of
-              [] -> "{}"
-              ts -> "{" ++ show (head ts) ++
-                      concat (map (\x -> "," ++ show x) (tail ts)) ++ "}"
+              [] -> "<{}>"
+              ts -> "<{" ++ show (head ts) ++
+                      concat (map (\x -> "," ++ show x) (tail ts)) ++ "}>"
         in show t ++ " " ++ struc
 
   show (LMStaticPointer v) = show v
@@ -152,14 +159,16 @@ instance Show LlvmStatic where
 
   show (LMAdd s1 s2)
       = let ty1 = getStatType s1
+            op  = if isFloat ty1 then " fadd (" else " add ("
         in if ty1 == getStatType s2
-                then show ty1 ++ " add (" ++ show s1 ++ "," ++ show s2 ++ ")"
+                then show ty1 ++ op ++ show s1 ++ "," ++ show s2 ++ ")"
                 else error $ "LMAdd with different types! s1: "
                         ++ show s1 ++ ", s2: " ++ show s2
   show (LMSub s1 s2)
       = let ty1 = getStatType s1
+            op  = if isFloat ty1 then " fsub (" else " sub ("
         in if ty1 == getStatType s2
-                then show ty1 ++ " sub (" ++ show s1 ++ "," ++ show s2 ++ ")"
+                then show ty1 ++ op ++ show s1 ++ "," ++ show s2 ++ ")"
                 else error $ "LMSub with different types! s1: "
                         ++ show s1 ++ ", s2: " ++ show s2
 
@@ -200,6 +209,8 @@ getLit (LMIntLit   i _) = show ((fromInteger i)::Int)
 getLit (LMFloatLit r LMFloat ) = fToStr $ realToFrac r
 getLit (LMFloatLit r LMDouble) = dToStr r
 getLit f@(LMFloatLit _ _) = error $ "Can't print this float literal!" ++ show f
+getLit (LMNullLit _) = "null"
+getLit (LMUndefLit _) = "undef"
 
 -- | Return the 'LlvmType' of the 'LlvmVar'
 getVarType :: LlvmVar -> LlvmType
@@ -212,6 +223,8 @@ getVarType (LMLitVar    l          ) = getLitType l
 getLitType :: LlvmLit -> LlvmType
 getLitType (LMIntLit   _ t) = t
 getLitType (LMFloatLit _ t) = t
+getLitType (LMNullLit    t) = t
+getLitType (LMUndefLit   t) = t
 
 -- | Return the 'LlvmType' of the 'LlvmStatic'
 getStatType :: LlvmStatic -> LlvmType
@@ -351,14 +364,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]
 
@@ -630,10 +646,14 @@ data LlvmMachOp
   | LM_MO_Mul  -- ^ multiply ..
   | LM_MO_UDiv -- ^ unsigned integer or vector division.
   | LM_MO_SDiv -- ^ signed integer ..
-  | LM_MO_FDiv -- ^ floating point ..
   | LM_MO_URem -- ^ unsigned integer or vector remainder (mod)
   | LM_MO_SRem -- ^ signed ...
-  | LM_MO_FRem -- ^ floating point ...
+
+  | LM_MO_FAdd -- ^ add two floating point or vector values.
+  | LM_MO_FSub -- ^ subtract two ...
+  | LM_MO_FMul -- ^ multiply ...
+  | LM_MO_FDiv -- ^ divide ...
+  | LM_MO_FRem -- ^ remainder ...
 
   -- | Left shift
   | LM_MO_Shl
@@ -656,9 +676,12 @@ instance Show LlvmMachOp where
   show LM_MO_Mul  = "mul"
   show LM_MO_UDiv = "udiv"
   show LM_MO_SDiv = "sdiv"
-  show LM_MO_FDiv = "fdiv"
   show LM_MO_URem = "urem"
   show LM_MO_SRem = "srem"
+  show LM_MO_FAdd = "fadd"
+  show LM_MO_FSub = "fsub"
+  show LM_MO_FMul = "fmul"
+  show LM_MO_FDiv = "fdiv"
   show LM_MO_FRem = "frem"
   show LM_MO_Shl  = "shl"
   show LM_MO_LShr = "lshr"