Add support for LLVM vectors.

This patch adds support for LLVM vectors and vector operations to our internal
LLVM abstract syntax data types.

4 files changed, 71 insertions, 27 deletions

diff --git a/compiler/llvmGen/Llvm.hs b/compiler/llvmGen/Llvm.hs
index d05a90609e..d69b88ce23 100644
--- a/compiler/llvmGen/Llvm.hs
+++ b/compiler/llvmGen/Llvm.hs
@@ -43,7 +43,7 @@ module Llvm (
         -- ** Operations on the type system.
         isGlobal, getLitType, getLit, getName, getPlainName, getVarType,
         getLink, getStatType, getGlobalVar, getGlobalType, pVarLift, pVarLower,
-        pLift, pLower, isInt, isFloat, isPointer, llvmWidthInBits,
+        pLift, pLower, isInt, isFloat, isPointer, isVector, llvmWidthInBits,
 
         -- * Pretty Printing
         ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmGlobals,
diff --git a/compiler/llvmGen/Llvm/AbsSyn.hs b/compiler/llvmGen/Llvm/AbsSyn.hs
index 9133447331..f5f5eacdee 100644
--- a/compiler/llvmGen/Llvm/AbsSyn.hs
+++ b/compiler/llvmGen/Llvm/AbsSyn.hs
@@ -198,6 +198,21 @@ data LlvmExpression
   | Compare LlvmCmpOp LlvmVar LlvmVar
 
   {- |
+    Extract a scalar element from a vector
+      * val: The vector
+      * idx: The index of the scalar within the vector
+  -}
+  | Extract LlvmVar LlvmVar
+
+  {- |
+    Insert a scalar element into a vector
+      * val:   The source vector
+      * elt:   The scalar to insert
+      * index: The index at which to insert the scalar
+  -}
+  | Insert LlvmVar LlvmVar LlvmVar
+
+  {- |
     Allocate amount * sizeof(tp) bytes on the heap
       * tp:     LlvmType to reserve room for
       * amount: The nr of tp's which must be allocated
diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
index 2b2725d187..2d4be3f8d0 100644
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
@@ -230,6 +230,8 @@ ppLlvmExpression expr
         Call       tp fp args attrs -> ppCall tp fp args attrs
         Cast       op from to       -> ppCast op from to
         Compare    op left right    -> ppCmpOp op left right
+        Extract    vec idx          -> ppExtract vec idx
+        Insert     vec elt idx      -> ppInsert vec elt idx
         GetElemPtr inb ptr indexes  -> ppGetElementPtr inb ptr indexes
         Load       ptr              -> ppLoad ptr
         Malloc     tp amount        -> ppMalloc tp amount
@@ -383,6 +385,18 @@ ppAsm asm constraints rty vars sideeffect alignstack =
   in text "call" <+> rty' <+> text "asm" <+> side <+> align <+> asm' <> comma
         <+> cons <> vars'
 
+ppExtract :: LlvmVar -> LlvmVar -> SDoc
+ppExtract vec idx =
+    text "extractelement"
+    <+> texts (getVarType vec) <+> text (getName vec) <> comma
+    <+> texts idx
+
+ppInsert :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc
+ppInsert vec elt idx =
+    text "insertelement"
+    <+> texts (getVarType vec) <+> text (getName vec) <> comma
+    <+> texts (getVarType elt) <+> text (getName elt) <> comma
+    <+> texts idx
 
 ppMetaStatement :: [MetaData] -> LlvmStatement -> SDoc
 ppMetaStatement meta stmt = ppLlvmStatement stmt <> ppMetas meta
diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index c4d9995e47..8b33c0b9dd 100644
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -13,6 +13,7 @@ import Numeric
 
 import DynFlags
 import FastString
+import Outputable (panic)
 import Unique
 
 -- from NCG
@@ -34,33 +35,35 @@ type LlvmAlias = (LMString, LlvmType)
 
 -- | Llvm Types
 data LlvmType
-  = LMInt Int            -- ^ An integer with a given width in bits.
-  | LMFloat              -- ^ 32 bit floating point
-  | LMDouble             -- ^ 64 bit floating point
-  | LMFloat80            -- ^ 80 bit (x86 only) floating point
-  | LMFloat128           -- ^ 128 bit floating point
-  | LMPointer LlvmType   -- ^ A pointer to a 'LlvmType'
-  | LMArray Int LlvmType -- ^ An array of 'LlvmType'
-  | LMLabel              -- ^ A 'LlvmVar' can represent a label (address)
-  | LMVoid               -- ^ Void type
-  | LMStruct [LlvmType]  -- ^ Structure type
-  | LMAlias LlvmAlias    -- ^ A type alias
+  = LMInt Int             -- ^ An integer with a given width in bits.
+  | LMFloat               -- ^ 32 bit floating point
+  | LMDouble              -- ^ 64 bit floating point
+  | LMFloat80             -- ^ 80 bit (x86 only) floating point
+  | LMFloat128            -- ^ 128 bit floating point
+  | LMPointer LlvmType    -- ^ A pointer to a 'LlvmType'
+  | LMArray Int LlvmType  -- ^ An array of 'LlvmType'
+  | LMVector Int LlvmType -- ^ A vector of 'LlvmType'
+  | LMLabel               -- ^ A 'LlvmVar' can represent a label (address)
+  | LMVoid                -- ^ Void type
+  | LMStruct [LlvmType]   -- ^ Structure type
+  | LMAlias LlvmAlias     -- ^ A type alias
 
   -- | Function type, used to create pointers to functions
   | LMFunction LlvmFunctionDecl
   deriving (Eq)
 
 instance Show LlvmType where
-  show (LMInt size    ) = "i" ++ show size
-  show (LMFloat       ) = "float"
-  show (LMDouble      ) = "double"
-  show (LMFloat80     ) = "x86_fp80"
-  show (LMFloat128    ) = "fp128"
-  show (LMPointer x   ) = show x ++ "*"
-  show (LMArray nr tp ) = "[" ++ show nr ++ " x " ++ show tp ++ "]"
-  show (LMLabel       ) = "label"
-  show (LMVoid        ) = "void"
-  show (LMStruct tys  ) = "<{" ++ (commaCat tys) ++ "}>"
+  show (LMInt size     ) = "i" ++ show size
+  show (LMFloat        ) = "float"
+  show (LMDouble       ) = "double"
+  show (LMFloat80      ) = "x86_fp80"
+  show (LMFloat128     ) = "fp128"
+  show (LMPointer x    ) = show x ++ "*"
+  show (LMArray nr tp  ) = "[" ++ show nr ++ " x " ++ show tp ++ "]"
+  show (LMVector nr tp ) = "<" ++ show nr ++ " x " ++ show tp ++ ">"
+  show (LMLabel        ) = "label"
+  show (LMVoid         ) = "void"
+  show (LMStruct tys   ) = "<{" ++ (commaCat tys) ++ "}>"
 
   show (LMFunction (LlvmFunctionDecl _ _ _ r varg p _))
     = let varg' = case varg of
@@ -143,12 +146,15 @@ data LlvmLit
   | LMFloatLit Double LlvmType
   -- | Literal NULL, only applicable to pointer types
   | LMNullLit LlvmType
+  -- | Vector literal
+  | LMVectorLit [LlvmLit]
   -- | Undefined value, random bit pattern. Useful for optimisations.
   | LMUndefLit LlvmType
   deriving (Eq)
 
 instance Show LlvmLit where
-  show l = show (getLitType l) ++ " " ++ getLit l
+  show l@(LMVectorLit {}) = getLit l
+  show l                  = show (getLitType l) ++ " " ++ getLit l
 
 
 -- | Llvm Static Data.
@@ -233,6 +239,7 @@ getLit (LMIntLit i _         ) = show (fromInteger i :: Int)
 getLit (LMFloatLit r LMFloat ) = (dToStr . widenFp . narrowFp) r
 getLit (LMFloatLit r LMDouble) = dToStr r
 getLit f@(LMFloatLit _ _) = error $ "Can't print this float literal!" ++ show f
+getLit (LMVectorLit ls  ) = "< " ++ commaCat ls ++ " >"
 getLit (LMNullLit _     ) = "null"
 getLit (LMUndefLit _    ) = "undef"
 
@@ -245,10 +252,12 @@ getVarType (LMLitVar    l          ) = getLitType l
 
 -- | Return the 'LlvmType' of a 'LlvmLit'
 getLitType :: LlvmLit -> LlvmType
-getLitType (LMIntLit   _ t) = t
-getLitType (LMFloatLit _ t) = t
-getLitType (LMNullLit    t) = t
-getLitType (LMUndefLit   t) = t
+getLitType (LMIntLit    _ t) = t
+getLitType (LMFloatLit  _ t) = t
+getLitType (LMVectorLit [])  = panic "getLitType"
+getLitType (LMVectorLit ls)  = LMVector (length ls) (getLitType (head ls))
+getLitType (LMNullLit     t) = t
+getLitType (LMUndefLit    t) = t
 
 -- | Return the 'LlvmType' of the 'LlvmStatic'
 getStatType :: LlvmStatic -> LlvmType
@@ -322,6 +331,11 @@ isPointer :: LlvmType -> Bool
 isPointer (LMPointer _) = True
 isPointer _             = False
 
+-- | Test if the given 'LlvmType' is an 'LMVector' construct
+isVector :: LlvmType -> Bool
+isVector (LMVector {}) = True
+isVector _             = False
+
 -- | Test if a 'LlvmVar' is global.
 isGlobal :: LlvmVar -> Bool
 isGlobal (LMGlobalVar _ _ _ _ _ _) = True
@@ -338,6 +352,7 @@ llvmWidthInBits _      (LMFloat128)    = 128
 -- it points to. We will go with the former for now.
 llvmWidthInBits dflags (LMPointer _)   = llvmWidthInBits dflags (llvmWord dflags)
 llvmWidthInBits dflags (LMArray _ _)   = llvmWidthInBits dflags (llvmWord dflags)
+llvmWidthInBits dflags (LMVector n ty) = n * llvmWidthInBits dflags ty
 llvmWidthInBits _      LMLabel         = 0
 llvmWidthInBits _      LMVoid          = 0
 llvmWidthInBits dflags (LMStruct tys)  = sum $ map (llvmWidthInBits dflags) tys