+
+-- | Vectorise a single type construcrtor.
+vectTyConDecl :: TyCon -> VM TyCon
+vectTyConDecl tycon
+ -- a type class constructor.
+ -- TODO: check for no stupid theta, fds, assoc types.
+ | isClassTyCon tycon
+ , Just cls <- tyConClass_maybe tycon
+
+ = do -- make the name of the vectorised class tycon.
+ name' <- cloneName mkVectTyConOcc (tyConName tycon)
+
+ -- vectorise right of definition.
+ rhs' <- vectAlgTyConRhs tycon (algTyConRhs tycon)
+
+ -- vectorise method selectors.
+ -- This also adds a mapping between the original and vectorised method selector
+ -- to the state.
+ methods' <- mapM vectMethod
+ $ [(id, defMethSpecOfDefMeth meth)
+ | (id, meth) <- classOpItems cls]
+
+ -- keep the original recursiveness flag.
+ let rec_flag = boolToRecFlag (isRecursiveTyCon tycon)
+
+ -- Calling buildclass here attaches new quantifiers and dictionaries to the method types.
+ cls' <- liftDs
+ $ buildClass
+ False -- include unfoldings on dictionary selectors.
+ name' -- new name V_T:Class
+ (tyConTyVars tycon) -- keep original type vars
+ [] -- no stupid theta
+ [] -- no functional dependencies
+ [] -- no associated types
+ methods' -- method info
+ rec_flag -- whether recursive
+
+ let tycon' = mkClassTyCon name'
+ (tyConKind tycon)
+ (tyConTyVars tycon)
+ rhs'
+ cls'
+ rec_flag
+
+ return $ tycon'
+
+ -- a regular algebraic type constructor.
+ -- TODO: check for stupid theta, generaics, GADTS etc
+ | isAlgTyCon tycon
+ = do name' <- cloneName mkVectTyConOcc (tyConName tycon)
+ rhs' <- vectAlgTyConRhs tycon (algTyConRhs tycon)
+ let rec_flag = boolToRecFlag (isRecursiveTyCon tycon)
+
+ liftDs $ buildAlgTyCon
+ name' -- new name
+ (tyConTyVars tycon) -- keep original type vars.
+ [] -- no stupid theta.
+ rhs' -- new constructor defs.
+ rec_flag -- FIXME: is this ok?
+ False -- FIXME: no generics
+ False -- not GADT syntax
+ Nothing -- not a family instance
+
+ -- some other crazy thing that we don't handle.
+ | otherwise
+ = cantVectorise "Can't vectorise type constructor: " (ppr tycon)
+
+
+-- | Vectorise a class method.
+vectMethod :: (Id, DefMethSpec) -> VM (Name, DefMethSpec, Type)
+vectMethod (id, defMeth)
+ = do
+ -- Vectorise the method type.
+ typ' <- vectType (varType id)
+
+ -- Create a name for the vectorised method.
+ id' <- cloneId mkVectOcc id typ'
+ defGlobalVar id id'
+
+ -- When we call buildClass in vectTyConDecl, it adds foralls and dictionaries
+ -- to the types of each method. However, the types we get back from vectType
+ -- above already already have these, so we need to chop them off here otherwise
+ -- we'll get two copies in the final version.
+ let (_tyvars, tyBody) = splitForAllTys typ'
+ let (_dict, tyRest) = splitFunTy tyBody
+
+ return (Var.varName id', defMeth, tyRest)
+
+
+-- | Vectorise the RHS of an algebraic type.
+vectAlgTyConRhs :: TyCon -> AlgTyConRhs -> VM AlgTyConRhs
+vectAlgTyConRhs _ (DataTyCon { data_cons = data_cons
+ , is_enum = is_enum
+ })