+ name' <- cloneName mkPArrayTyConOcc name
+ parent <- buildPArrayParentInfo orig_tc repr_tc
+ rhs <- buildPArrayTyConRhs orig_tc repr_tc
+
+ return $ mkAlgTyCon name'
+ kind
+ tyvars
+ [] -- no stupid theta
+ rhs
+ [] -- no selector ids
+ parent
+ rec_flag -- FIXME: is this ok?
+ False -- FIXME: no generics
+ False -- not GADT syntax
+ where
+ name = tyConName orig_tc
+ kind = tyConKind orig_tc
+ tyvars = tyConTyVars orig_tc
+ rec_flag = boolToRecFlag (isRecursiveTyCon orig_tc)
+
+
+buildPArrayParentInfo :: TyCon -> TyCon -> VM TyConParent
+buildPArrayParentInfo orig_tc repr_tc
+ = do
+ parray_tc <- builtin parrayTyCon
+ co_name <- cloneName mkInstTyCoOcc (tyConName repr_tc)
+
+ let inst_tys = [mkTyConApp orig_tc (map mkTyVarTy tyvars)]
+
+ return . FamilyTyCon parray_tc inst_tys
+ $ mkFamInstCoercion co_name
+ tyvars
+ parray_tc
+ inst_tys
+ repr_tc
+ where
+ tyvars = tyConTyVars orig_tc
+
+buildPArrayTyConRhs :: TyCon -> TyCon -> VM AlgTyConRhs
+buildPArrayTyConRhs orig_tc repr_tc
+ = do
+ data_con <- buildPArrayDataCon orig_tc repr_tc
+ return $ DataTyCon { data_cons = [data_con], is_enum = False }