+ unlessSomeNoVectDecl vectorise
+ = do { hasNoVectDecls <- mapM noVectDecl vars
+ ; when (and hasNoVectDecls) $
+ traceVt "NOVECTORISE" $ ppr vars
+ ; if and hasNoVectDecls
+ then return b -- all bindings have 'NOVECTORISE'
+ else if or hasNoVectDecls
+ then cantVectorise noVectoriseErr (ppr b) -- some (but not all) have 'NOVECTORISE'
+ else vectorise -- no binding has a 'NOVECTORISE' decl
+ }
+ noVectoriseErr = "NOVECTORISE must be used on all or no bindings of a recursive group"
+
+-- | Make the vectorised version of this top level binder, and add the mapping
+-- between it and the original to the state. For some binder @foo@ the vectorised
+-- version is @$v_foo@
+--
+-- NOTE: 'vectTopBinder' *MUST* be lazy in inline and expr because of how it is
+-- used inside of 'fixV' in 'vectTopBind'.
+--
+vectTopBinder :: Var -- ^ Name of the binding.
+ -> Inline -- ^ Whether it should be inlined, used to annotate it.
+ -> CoreExpr -- ^ RHS of binding, used to set the 'Unfolding' of the returned 'Var'.
+ -> VM Var -- ^ Name of the vectorised binding.
+vectTopBinder var inline expr
+ = do { -- Vectorise the type attached to the var.
+ ; vty <- vectType (idType var)
+
+ -- If there is a vectorisation declartion for this binding, make sure that its type
+ -- matches
+ ; vectDecl <- lookupVectDecl var
+ ; case vectDecl of
+ Nothing -> return ()
+ Just (vdty, _)
+ | eqType vty vdty -> return ()
+ | otherwise ->
+ cantVectorise ("Type mismatch in vectorisation pragma for " ++ show var) $
+ (text "Expected type" <+> ppr vty)
+ $$
+ (text "Inferred type" <+> ppr vdty)
+
+ -- Make the vectorised version of binding's name, and set the unfolding used for inlining
+ ; var' <- liftM (`setIdUnfoldingLazily` unfolding)
+ $ cloneId mkVectOcc var vty
+
+ -- Add the mapping between the plain and vectorised name to the state.
+ ; defGlobalVar var var'
+
+ ; return var'
+ }