Commit 2b63f556 authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au
Browse files

Move code

parent 72442526
...@@ -250,6 +250,24 @@ buildToPRepr (TyConRepr { ...@@ -250,6 +250,24 @@ buildToPRepr (TyConRepr {
where where
[dc] = tyConDataCons tc [dc] = tyConDataCons tc
buildFromPRepr :: TyConRepr -> TyCon -> TyCon -> TyCon -> VM CoreExpr
buildFromPRepr _ vect_tc prepr_tc _
= do
arg_ty <- mkPReprType res_ty
arg <- newLocalVar FSLIT("x") arg_ty
alts <- mapM mk_alt data_cons
body <- mkFromPRepr (unwrapFamInstScrut prepr_tc var_tys (Var arg))
res_ty alts
return $ Lam arg body
where
var_tys = mkTyVarTys $ tyConTyVars vect_tc
res_ty = mkTyConApp vect_tc var_tys
data_cons = tyConDataCons vect_tc
mk_alt dc = do
bndrs <- mapM (newLocalVar FSLIT("x")) $ dataConRepArgTys dc
return (bndrs, mkConApp dc (map Type var_tys ++ map Var bndrs))
buildToArrPRepr :: TyConRepr -> TyCon -> TyCon -> TyCon -> VM CoreExpr buildToArrPRepr :: TyConRepr -> TyCon -> TyCon -> TyCon -> VM CoreExpr
buildToArrPRepr _ vect_tc prepr_tc arr_tc buildToArrPRepr _ vect_tc prepr_tc arr_tc
= do = do
...@@ -286,25 +304,6 @@ buildToArrPRepr _ vect_tc prepr_tc arr_tc ...@@ -286,25 +304,6 @@ buildToArrPRepr _ vect_tc prepr_tc arr_tc
has_selector | [_] <- data_cons = False has_selector | [_] <- data_cons = False
| otherwise = True | otherwise = True
buildFromPRepr :: TyConRepr -> TyCon -> TyCon -> TyCon -> VM CoreExpr
buildFromPRepr _ vect_tc prepr_tc _
= do
arg_ty <- mkPReprType res_ty
arg <- newLocalVar FSLIT("x") arg_ty
alts <- mapM mk_alt data_cons
body <- mkFromPRepr (unwrapFamInstScrut prepr_tc var_tys (Var arg))
res_ty alts
return $ Lam arg body
where
var_tys = mkTyVarTys $ tyConTyVars vect_tc
res_ty = mkTyConApp vect_tc var_tys
data_cons = tyConDataCons vect_tc
mk_alt dc = do
bndrs <- mapM (newLocalVar FSLIT("x")) $ dataConRepArgTys dc
return (bndrs, mkConApp dc (map Type var_tys ++ map Var bndrs))
buildFromArrPRepr :: TyConRepr -> TyCon -> TyCon -> TyCon -> VM CoreExpr buildFromArrPRepr :: TyConRepr -> TyCon -> TyCon -> TyCon -> VM CoreExpr
buildFromArrPRepr _ vect_tc prepr_tc arr_tc buildFromArrPRepr _ vect_tc prepr_tc arr_tc
= mkFromArrPRepr undefined undefined undefined undefined undefined undefined = mkFromArrPRepr undefined undefined undefined undefined undefined undefined
......
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