-buildEnv :: Var -> [VVar] -> VM (Type, VExpr, VExpr -> VExpr -> VM VExpr)
-buildEnv lv vvs
- = do
- let (ty, venv, vbind) = mkVectEnv tys vs
- (lenv, lbind) <- mkLiftEnv lv tys ls
- return (ty, (venv, lenv),
- \(venv,lenv) (vbody,lbody) ->
- do
- let vbody' = vbind venv vbody
- lbody' <- lbind lenv lbody
- return (vbody', lbody'))
- where
- (vs,ls) = unzip vvs
- tys = map idType vs
-
-mkVectEnv :: [Type] -> [Var] -> (Type, CoreExpr, CoreExpr -> CoreExpr -> CoreExpr)
-mkVectEnv [] [] = (unitTy, Var unitDataConId, \env body -> body)
-mkVectEnv [ty] [v] = (ty, Var v, \env body -> Let (NonRec v env) body)
-mkVectEnv tys vs = (ty, mkCoreTup (map Var vs),
- \env body -> Case env (mkWildId ty) (exprType body)
- [(DataAlt (tupleCon Boxed (length vs)), vs, body)])
- where
- ty = mkCoreTupTy tys
-
-mkLiftEnv :: Var -> [Type] -> [Var] -> VM (CoreExpr, CoreExpr -> CoreExpr -> VM CoreExpr)
-mkLiftEnv lv [ty] [v]
- = return (Var v, \env body ->
- do
- len <- lengthPA (Var v)
- return . Let (NonRec v env)
- $ Case len lv (exprType body) [(DEFAULT, [], body)])
-
--- NOTE: this transparently deals with empty environments
-mkLiftEnv lv tys vs
+buildEnv :: [VVar] -> VM (Type, VExpr, VExpr -> VExpr -> VExpr)
+buildEnv [] = do
+ ty <- voidType
+ void <- builtin voidVar
+ pvoid <- builtin pvoidVar
+ return (ty, vVar (void, pvoid), \_ body -> body)
+
+buildEnv [v] = return (vVarType v, vVar v,
+ \env body -> vLet (vNonRec v env) body)
+
+buildEnv vs