Safe Haskell | None |
---|---|
Language | Haskell2010 |
- data Message a where
- Shutdown :: Message ()
- InitLinker :: Message ()
- LookupSymbol :: String -> Message (Maybe (RemotePtr ()))
- LookupClosure :: String -> Message (Maybe HValueRef)
- LoadDLL :: String -> Message (Maybe String)
- LoadArchive :: String -> Message ()
- LoadObj :: String -> Message ()
- UnloadObj :: String -> Message ()
- AddLibrarySearchPath :: String -> Message (RemotePtr ())
- RemoveLibrarySearchPath :: RemotePtr () -> Message Bool
- ResolveObjs :: Message Bool
- FindSystemLibrary :: String -> Message (Maybe String)
- CreateBCOs :: [ByteString] -> Message [HValueRef]
- FreeHValueRefs :: [HValueRef] -> Message ()
- MallocData :: ByteString -> Message (RemotePtr ())
- MallocStrings :: [ByteString] -> Message [RemotePtr ()]
- PrepFFI :: FFIConv -> [FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif)
- FreeFFI :: RemotePtr C_ffi_cif -> Message ()
- MkConInfoTable :: Int -> Int -> Int -> [Word8] -> Message (RemotePtr StgInfoTable)
- EvalStmt :: EvalOpts -> EvalExpr HValueRef -> Message (EvalStatus [HValueRef])
- ResumeStmt :: EvalOpts -> RemoteRef (ResumeContext [HValueRef]) -> Message (EvalStatus [HValueRef])
- AbandonStmt :: RemoteRef (ResumeContext [HValueRef]) -> Message ()
- EvalString :: HValueRef -> Message (EvalResult String)
- EvalStringToString :: HValueRef -> String -> Message (EvalResult String)
- EvalIO :: HValueRef -> Message (EvalResult ())
- MkCostCentres :: String -> [(String, String)] -> Message [RemotePtr CostCentre]
- CostCentreStackInfo :: RemotePtr CostCentreStack -> Message [String]
- NewBreakArray :: Int -> Message (RemoteRef BreakArray)
- EnableBreakpoint :: RemoteRef BreakArray -> Int -> Bool -> Message ()
- BreakpointStatus :: RemoteRef BreakArray -> Int -> Message Bool
- GetBreakpointVar :: HValueRef -> Int -> Message (Maybe HValueRef)
- StartTH :: Message (RemoteRef (IORef QState))
- FinishTH :: RemoteRef (IORef QState) -> Message ()
- RunTH :: RemoteRef (IORef QState) -> HValueRef -> THResultType -> Maybe Loc -> Message ByteString
- NewName :: String -> Message (THResult Name)
- Report :: Bool -> String -> Message (THResult ())
- LookupName :: Bool -> String -> Message (THResult (Maybe Name))
- Reify :: Name -> Message (THResult Info)
- ReifyFixity :: Name -> Message (THResult (Maybe Fixity))
- ReifyInstances :: Name -> [Type] -> Message (THResult [Dec])
- ReifyRoles :: Name -> Message (THResult [Role])
- ReifyAnnotations :: AnnLookup -> TypeRep -> Message (THResult [ByteString])
- ReifyModule :: Module -> Message (THResult ModuleInfo)
- ReifyConStrictness :: Name -> Message (THResult [DecidedStrictness])
- AddDependentFile :: FilePath -> Message (THResult ())
- AddTopDecls :: [Dec] -> Message (THResult ())
- IsExtEnabled :: Extension -> Message (THResult Bool)
- ExtsEnabled :: Message (THResult [Extension])
- StartRecover :: Message ()
- EndRecover :: Bool -> Message ()
- QDone :: Message ()
- QException :: String -> Message ()
- QFail :: String -> Message ()
- data Msg = (Binary a, Show a) => Msg (Message a)
- data EvalStatus_ a b
- = EvalComplete Word64 (EvalResult a)
- | EvalBreak Bool HValueRef Int Int (RemoteRef (ResumeContext b)) (RemotePtr CostCentreStack)
- type EvalStatus a = EvalStatus_ a a
- data EvalResult a
- data EvalOpts = EvalOpts {}
- data EvalExpr a
- data SerializableException
- data THResult a
- = THException String
- | THComplete a
- data THResultType
- = THExp
- | THPat
- | THType
- | THDec
- | THAnnWrapper
- data ResumeContext a = ResumeContext {
- resumeBreakMVar :: MVar ()
- resumeStatusMVar :: MVar (EvalStatus a)
- resumeThreadId :: ThreadId
- data QState = QState {}
- getMessage :: Get Msg
- putMessage :: Message a -> Put
- data Pipe = Pipe {
- pipeRead :: Handle
- pipeWrite :: Handle
- pipeLeftovers :: IORef (Maybe ByteString)
- remoteCall :: Binary a => Pipe -> Message a -> IO a
- readPipe :: Pipe -> Get a -> IO a
- writePipe :: Pipe -> Put -> IO ()
Documentation
A Message a
is a message that returns a value of type a
data EvalStatus_ a b Source
EvalComplete Word64 (EvalResult a) | |
EvalBreak Bool HValueRef Int Int (RemoteRef (ResumeContext b)) (RemotePtr CostCentreStack) |
type EvalStatus a = EvalStatus_ a a Source
data EvalResult a Source
Show a => Show (EvalResult a) | |
Generic (EvalResult a) | |
Binary a => Binary (EvalResult a) | |
type Rep (EvalResult a) = D1 (MetaData "EvalResult" "GHCi.Message" "ghci-8.0.0.20160204" False) ((:+:) (C1 (MetaCons "EvalException" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 SerializableException))) (C1 (MetaCons "EvalSuccess" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)))) |
EvalOpts | |
|
Show EvalOpts | |
Generic EvalOpts | |
Binary EvalOpts | |
type Rep EvalOpts = D1 (MetaData "EvalOpts" "GHCi.Message" "ghci-8.0.0.20160204" False) (C1 (MetaCons "EvalOpts" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "useSandboxThread") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool)) (S1 (MetaSel (Just Symbol "singleStep") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool))) ((:*:) (S1 (MetaSel (Just Symbol "breakOnException") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool)) (S1 (MetaSel (Just Symbol "breakOnError") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool))))) |
We can pass simple expressions to EvalStmt, consisting of values and application. This allows us to wrap the statement to be executed in another function, which is used by GHCi to implement :set args and :set prog. It might be worthwhile to extend this little language in the future.
Show a => Show (EvalExpr a) | |
Generic (EvalExpr a) | |
Binary a => Binary (EvalExpr a) | |
type Rep (EvalExpr a) = D1 (MetaData "EvalExpr" "GHCi.Message" "ghci-8.0.0.20160204" False) ((:+:) (C1 (MetaCons "EvalThis" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a))) (C1 (MetaCons "EvalApp" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (EvalExpr a))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (EvalExpr a)))))) |
data SerializableException Source
Show SerializableException | |
Generic SerializableException | |
Binary SerializableException | |
type Rep SerializableException = D1 (MetaData "SerializableException" "GHCi.Message" "ghci-8.0.0.20160204" False) ((:+:) (C1 (MetaCons "EUserInterrupt" PrefixI False) U1) ((:+:) (C1 (MetaCons "EExitCode" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ExitCode))) (C1 (MetaCons "EOtherException" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String))))) |
Show a => Show (THResult a) | |
Generic (THResult a) | |
Binary a => Binary (THResult a) | |
type Rep (THResult a) = D1 (MetaData "THResult" "GHCi.Message" "ghci-8.0.0.20160204" False) ((:+:) (C1 (MetaCons "THException" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String))) (C1 (MetaCons "THComplete" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)))) |
data THResultType Source
Enum THResultType | |
Show THResultType | |
Generic THResultType | |
Binary THResultType | |
type Rep THResultType = D1 (MetaData "THResultType" "GHCi.Message" "ghci-8.0.0.20160204" False) ((:+:) ((:+:) (C1 (MetaCons "THExp" PrefixI False) U1) (C1 (MetaCons "THPat" PrefixI False) U1)) ((:+:) (C1 (MetaCons "THType" PrefixI False) U1) ((:+:) (C1 (MetaCons "THDec" PrefixI False) U1) (C1 (MetaCons "THAnnWrapper" PrefixI False) U1)))) |
data ResumeContext a Source
ResumeContext | |
|
getMessage :: Get Msg Source
putMessage :: Message a -> Put Source
Pipe | |
|