Commit ae6161ec authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Until the type checker can use vectorised signatures, we restrict the RHS of...

Until the type checker can use vectorised signatures, we restrict the RHS of VECTORISE pragmas to be a single identifier only.

- This removes the need to be careful about the order of dictionaries during type inference. A property that is too fragile to try to maintain in the type checker.
parent d65efb22
......@@ -662,11 +662,18 @@ rnHsVectDecl (HsVect var Nothing)
= do { var' <- lookupLocatedTopBndrRn var
; return (HsVect var' Nothing, unitFV (unLoc var'))
}
rnHsVectDecl (HsVect var (Just rhs))
-- FIXME: For the moment, the right-hand side is restricted to be a variable as we cannot properly
-- typecheck a complex right-hand side without invoking 'vectType' from the vectoriser.
rnHsVectDecl (HsVect var (Just rhs@(L _ (HsVar _))))
= do { var' <- lookupLocatedTopBndrRn var
; (rhs', fv_rhs) <- rnLExpr rhs
; return (HsVect var' (Just rhs'), fv_rhs `addOneFV` unLoc var')
}
rnHsVectDecl (HsVect _var (Just _rhs))
= failWith $ vcat
[ ptext (sLit "IMPLEMENTATION RESTRICTION: right-hand side of a VECTORISE pragma")
, ptext (sLit "must be an identifier")
]
rnHsVectDecl (HsNoVect var)
= do { var' <- lookupLocatedTopBndrRn var
; return (HsNoVect var', unitFV (unLoc var'))
......@@ -681,7 +688,7 @@ rnHsVectDecl (HsVectTypeIn tycon (Just ty))
; return (HsVectTypeIn tycon' (Just ty'), fv_ty `addOneFV` unLoc tycon')
}
where
vect_doc = text "In the VECTORISE pragma for type constructor" <+> quotes (ppr tycon)
vect_doc = ptext (sLit "In the VECTORISE pragma for type constructor") <+> quotes (ppr tycon)
rnHsVectDecl (HsVectTypeOut _ _)
= panic "RnSource.rnHsVectDecl: Unexpected 'HsVectTypeOut'"
\end{code}
......
......@@ -641,19 +641,26 @@ tcVectDecls decls
--------------
tcVect :: VectDecl Name -> TcM (VectDecl TcId)
-- We can't typecheck the expression of a vectorisation declaration against the vectorised type
-- of the original definition as this requires internals of the vectoriser not available during
-- type checking. Instead, we infer the type of the expression and leave it to the vectoriser
-- to check the compatibility of the Core types.
-- FIXME: We can't typecheck the expression of a vectorisation declaration against the vectorised
-- type of the original definition as this requires internals of the vectoriser not available
-- during type checking. Instead, constrain the rhs of a vectorisation declaration to be a single
-- identifier (this is checked in 'rnHsVectDecl').
tcVect (HsVect name Nothing)
= addErrCtxt (vectCtxt name) $
do { id <- wrapLocM tcLookupId name
; return $ HsVect id Nothing
}
tcVect (HsVect name@(L loc _) (Just rhs))
= addErrCtxt (vectCtxt name) $
do { _id <- wrapLocM tcLookupId name -- need to ensure that the name is already defined
tcVect (HsVect lname@(L loc name) (Just rhs))
= addErrCtxt (vectCtxt lname) $
do { id <- tcLookupId name
; let L rhs_loc (HsVar rhs_var_name) = rhs
; rhs_id <- tcLookupId rhs_var_name
; let typedId = setIdType id (idType rhs_id)
; return $ HsVect (L loc typedId) (Just $ L rhs_loc (HsVar rhs_id))
}
{- OLD CODE:
-- turn the vectorisation declaration into a single non-recursive binding
; let bind = L loc $ mkTopFunBind name [mkSimpleMatch [] rhs]
sigFun = const Nothing
......@@ -661,7 +668,7 @@ tcVect (HsVect name@(L loc _) (Just rhs))
-- perform type inference (including generalisation)
; (binds, [id'], _) <- tcPolyInfer False True sigFun pragFun NonRecursive [bind]
; traceTc "tcVect inferred type" $ ppr (varType id')
; traceTc "tcVect bindings" $ ppr binds
......@@ -678,6 +685,7 @@ tcVect (HsVect name@(L loc _) (Just rhs))
-- to the vectoriser - see "Note [Typechecked vectorisation pragmas]" in HsDecls
; return $ HsVect (L loc id') (Just rhsWrapped)
}
-}
tcVect (HsNoVect name)
= addErrCtxt (vectCtxt name) $
do { id <- wrapLocM tcLookupId name
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment