maybeCantVectorise,
maybeCantVectoriseM,
+ -- * Debugging
+ traceVt, dumpOptVt, dumpVt,
+
-- * Control
noV, traceNoV,
ensureV, traceEnsureV,
orElseV,
fixV,
) where
+
import Vectorise.Builtins
import Vectorise.Env
import DsMonad
+import TcRnMonad
+import ErrUtils
import Outputable
-
+import DynFlags
+import StaticFlags
+
+import Control.Monad
+import System.IO (stderr)
+
-- The Vectorisation Monad ----------------------------------------------------
+
-- | Vectorisation can either succeed with new envionment and a value,
-- or return with failure.
data VResult a
Yes genv' lenv' x -> runVM (f x) bi genv' lenv'
No -> return No
+instance Functor VM where
+ fmap = liftM
+
+instance MonadIO VM where
+ liftIO = liftDs . liftIO
+
-- Lifting --------------------------------------------------------------------
-- | Lift a desugaring computation into the vectorisation monad.
Just x -> return x
Nothing -> cantVectorise s d
+
+-- Debugging ------------------------------------------------------------------
+
+-- |Output a trace message if -ddump-vt-trace is active.
+--
+traceVt :: String -> SDoc -> VM ()
+traceVt herald doc
+ | 1 <= opt_TraceLevel = liftDs $
+ traceOptIf Opt_D_dump_vt_trace $
+ hang (text herald) 2 doc
+ | otherwise = return ()
+
+-- |Dump the given program conditionally.
+--
+dumpOptVt :: DynFlag -> String -> SDoc -> VM ()
+dumpOptVt flag header doc
+ = do { b <- liftDs $ doptM flag
+ ; if b
+ then dumpVt header doc
+ else return ()
+ }
+
+-- |Dump the given program unconditionally.
+--
+dumpVt :: String -> SDoc -> VM ()
+dumpVt header doc
+ = do { unqual <- liftDs mkPrintUnqualifiedDs
+ ; liftIO $ printForUser stderr unqual (mkDumpDoc header doc)
+ }
+
-- Control --------------------------------------------------------------------
-- | Return some result saying we've failed.
noV :: VM a