SIMD primops are now generated using schemas that are polymorphic in

width and element type.

SIMD primops are now polymorphic in vector size and element type, but
only internally to the compiler. More specifically, utils/genprimopcode
has been extended so that it "knows" about SIMD vectors. This allows us
to, for example, write a single definition for the "add two vectors"
primop in primops.txt.pp and have it instantiated at many vector types.
This generates a primop in GHC.Prim for each vector type at which "add
two vectors" is instantiated, but only one data constructor for the
PrimOp data type, so the code generator is much, much simpler.

1 files changed, 40 insertions, 2 deletions

diff --git a/utils/genprimopcode/Syntax.hs b/utils/genprimopcode/Syntax.hs
index 333ea2c4c7..d0c380cf59 100644
--- a/utils/genprimopcode/Syntax.hs
+++ b/utils/genprimopcode/Syntax.hs
@@ -19,6 +19,15 @@ data Entry
                    cat   :: Category,    -- category
                    desc  :: String,      -- description
                    opts  :: [Option] }   -- default overrides
+    | PrimVecOpSpec { cons    :: String,    -- PrimOp name
+                      name    :: String,    -- name in prog text
+                      prefix  :: String,    -- prefix for generated names
+                      veclen  :: Int,       -- vector length
+                      elemrep :: String,    -- vector ElemRep
+                      ty      :: Ty,        -- type
+                      cat     :: Category,  -- category
+                      desc    :: String,    -- description
+                      opts    :: [Option] } -- default overrides
     | PseudoOpSpec { name  :: String,      -- name in prog text
                      ty    :: Ty,          -- type
                      desc  :: String,      -- description
@@ -29,6 +38,12 @@ data Entry
     | PrimClassSpec { cls   :: Ty,      -- name in prog text
                       desc  :: String,      -- description
                       opts  :: [Option] }   -- default overrides
+    | PrimVecTypeSpec { ty    :: Ty,      -- name in prog text
+                        prefix  :: String,    -- prefix for generated names
+                        veclen  :: Int,       -- vector length
+                        elemrep :: String,    -- vector ElemRep
+                        desc  :: String,      -- description
+                        opts  :: [Option] }   -- default overrides
     | Section { title :: String,         -- section title
                 desc  :: String }        -- description
     deriving Show
@@ -37,12 +52,17 @@ is_primop :: Entry -> Bool
 is_primop (PrimOpSpec _ _ _ _ _ _) = True
 is_primop _ = False
 
+is_primtype :: Entry -> Bool
+is_primtype (PrimTypeSpec {}) = True
+is_primtype _ = False
+
 -- a binding of property to value
 data Option
    = OptionFalse  String          -- name = False
    | OptionTrue   String          -- name = True
    | OptionString String String   -- name = { ... unparsed stuff ... }
    | OptionInteger String Int     -- name = <int>
+   | OptionVector [(String,String,Int)]  -- name = [(,...),...]
    | OptionFixity (Maybe Fixity)  -- fixity = infix{,l,r} <int> | Nothing
      deriving Show
 
@@ -62,7 +82,20 @@ data Ty
    deriving (Eq,Show)
 
 type TyVar = String
-type TyCon = String
+
+data TyCon = TyCon String
+           | SCALAR
+           | VECTOR
+           | VECTUPLE
+           | VecTyCon String String
+  deriving (Eq, Ord)
+
+instance Show TyCon where
+    show (TyCon tc)      = tc
+    show SCALAR          = "SCALAR"
+    show VECTOR          = "VECTOR"
+    show VECTUPLE        = "VECTUPLE"
+    show (VecTyCon tc _) = tc
 
 -- Follow definitions of Fixity and FixityDirection in GHC
 
@@ -118,7 +151,7 @@ sanityPrimOp def_names p
 
 sane_ty :: Category -> Ty -> Bool
 sane_ty Compare (TyF t1 (TyF t2 td)) 
-   | t1 == t2 && td == TyApp "Int#" []  = True
+   | t1 == t2 && td == TyApp (TyCon "Int#") []  = True
 sane_ty Monadic (TyF t1 td) 
    | t1 == td  = True
 sane_ty Dyadic (TyF t1 (TyF t2 td))
@@ -133,6 +166,7 @@ get_attrib_name (OptionFalse nm) = nm
 get_attrib_name (OptionTrue nm)  = nm
 get_attrib_name (OptionString nm _) = nm
 get_attrib_name (OptionInteger nm _) = nm
+get_attrib_name (OptionVector _) = "vector"
 get_attrib_name (OptionFixity _) = "fixity"
 
 lookup_attrib :: String -> [Option] -> Maybe Option
@@ -140,3 +174,7 @@ lookup_attrib _ [] = Nothing
 lookup_attrib nm (a:as) 
     = if get_attrib_name a == nm then Just a else lookup_attrib nm as
 
+is_vector :: Entry -> Bool
+is_vector i = case lookup_attrib "vector" (opts i) of
+                Nothing -> False
+                _       -> True