Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/a786d35bf30670060492434a80331e7ab6f5eb2c >--------------------------------------------------------------- commit a786d35bf30670060492434a80331e7ab6f5eb2c Author: David Terei <[email protected]> Date: Tue Apr 24 16:16:48 2012 -0700 Add GHCi monad. Experimental for now. >--------------------------------------------------------------- GHC/GHCi.hs | 44 ++++++++++++++++++++++++++++++++++++++++++++ base.cabal | 1 + 2 files changed, 45 insertions(+), 0 deletions(-) diff --git a/GHC/GHCi.hs b/GHC/GHCi.hs new file mode 100644 index 0000000..213a7c5 --- /dev/null +++ b/GHC/GHCi.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_HADDOCK hide #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.GHCi +-- Copyright : (c) The University of Glasgow 2012 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : [email protected] +-- Stability : internal +-- Portability : non-portable (GHC Extensions) +-- +-- The GHCi Monad lifting interface. +-- +-- EXPERIMENTAL! DON'T USE. +-- +----------------------------------------------------------------------------- + +-- #hide +module GHC.GHCi {-# WARNING "This is an unstable interface." #-} ( + GHCiSandboxIO(..), NoIO() + ) where + +import GHC.Base (IO(), Monad, (>>=), return, id, (.)) + +-- | A monad that can execute GHCi statements by lifting them out of +-- m into the IO monad. (e.g state monads) +class (Monad m) => GHCiSandboxIO m where + ghciStepIO :: m a -> IO a + +instance GHCiSandboxIO IO where + ghciStepIO = id + +-- | A monad that doesn't allow any IO. +newtype NoIO a = NoIO { noio :: IO a } + +instance Monad NoIO where + return a = NoIO (return a) + (>>=) k f = NoIO (noio k >>= noio . f) + +instance GHCiSandboxIO NoIO where + ghciStepIO = noio + diff --git a/base.cabal b/base.cabal index f0d4186..ea553d2 100644 --- a/base.cabal +++ b/base.cabal @@ -58,6 +58,7 @@ Library { GHC.Float.RealFracMethods, GHC.Foreign, GHC.ForeignPtr, + GHC.GHCi, GHC.Handle, GHC.IO, GHC.IO.Buffer, _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
