- = do
- builtins <- initBuiltins pkg
- builtin_vars <- initBuiltinVars builtins
- builtin_tycons <- initBuiltinTyCons builtins
- let builtin_datacons = initBuiltinDataCons builtins
- builtin_boxed <- initBuiltinBoxedTyCons builtins
- builtin_scalars <- initBuiltinScalars builtins
-
- eps <- liftIO $ hscEPS hsc_env
- let famInstEnvs = (eps_fam_inst_env eps, mg_fam_inst_env guts)
- instEnvs = (eps_inst_env eps, mg_inst_env guts)
-
- builtin_prs <- initBuiltinPRs builtins instEnvs
- builtin_pas <- initBuiltinPAs builtins instEnvs
-
- let genv = extendImportedVarsEnv builtin_vars
- . extendScalars builtin_scalars
- . extendTyConsEnv builtin_tycons
- . extendDataConsEnv builtin_datacons
- . extendPAFunsEnv builtin_pas
- . setPRFunsEnv builtin_prs
- . setBoxedTyConsEnv builtin_boxed
- $ initGlobalEnv info instEnvs famInstEnvs
-
- r <- runVM p builtins genv emptyLocalEnv
- case r of
- Yes genv _ x -> return $ Just (new_info genv, x)
- No -> return Nothing
+ = do { -- pick a DPH backend
+ ; dflags <- getDOptsDs
+ ; case dphPackageMaybe dflags of
+ Nothing -> failWithDs $ ptext selectBackendErr
+ Just pkg -> do {
+
+ -- set up tables of builtin entities
+ ; let compilingDPH = dphBackend dflags == DPHThis -- FIXME: temporary kludge support
+ ; builtins <- initBuiltins pkg
+ ; builtin_vars <- initBuiltinVars compilingDPH builtins
+ ; builtin_tycons <- initBuiltinTyCons builtins
+ ; let builtin_datacons = initBuiltinDataCons builtins
+ ; builtin_boxed <- initBuiltinBoxedTyCons builtins
+ ; builtin_scalars <- initBuiltinScalars compilingDPH builtins
+
+ -- set up class and type family envrionments
+ ; eps <- liftIO $ hscEPS hsc_env
+ ; let famInstEnvs = (eps_fam_inst_env eps, mg_fam_inst_env guts)
+ instEnvs = (eps_inst_env eps, mg_inst_env guts)
+ ; builtin_prs <- initBuiltinPRs builtins instEnvs
+ ; builtin_pas <- initBuiltinPAs builtins instEnvs
+
+ -- construct the initial global environment
+ ; let genv = extendImportedVarsEnv builtin_vars
+ . extendScalars builtin_scalars
+ . extendTyConsEnv builtin_tycons
+ . extendDataConsEnv builtin_datacons
+ . extendPAFunsEnv builtin_pas
+ . setPRFunsEnv builtin_prs
+ . setBoxedTyConsEnv builtin_boxed
+ $ initGlobalEnv info (mg_vect_decls guts) instEnvs famInstEnvs
+
+ -- perform vectorisation
+ ; r <- runVM thing_inside builtins genv emptyLocalEnv
+ ; case r of
+ Yes genv _ x -> return $ Just (new_info genv, x)
+ No -> return Nothing
+ } }